diff options
55 files changed, 553 insertions, 451 deletions
@@ -9018,8 +9018,8 @@ in this changeset (new minor version) rather than bug fixes: 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.4.3 -=> dde 1.3.5 +=> registry 1.3.5 +=> dde 1.4.3 2020-03-05 (new) Update to Unicode-13 (nijtmans) diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index ffb09f2..9b291fb 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -241,9 +241,9 @@ The structure that contains the result of a stat or lstat operation. Name of a procedure to look up in the file's symbol table .AP "const char" *sym2 in Name of a procedure to look up in the file's symbol table -.AP Tcl_PackageInitProc **proc1Ptr out +.AP Tcl_LibraryInitProc **proc1Ptr out Filled with the init function for this code. -.AP Tcl_PackageInitProc **proc2Ptr out +.AP Tcl_LibraryInitProc **proc2Ptr out Filled with the safe-init function for this code. .AP void **clientDataPtr out Filled with the clientData value to pass to this code's unload diff --git a/doc/PkgRequire.3 b/doc/PkgRequire.3 index 71f3acf..f32c936 100644 --- a/doc/PkgRequire.3 +++ b/doc/PkgRequire.3 @@ -94,4 +94,4 @@ compatibility and translate their invocations to this form. .SH KEYWORDS package, present, provide, require, version .SH "SEE ALSO" -package(n), Tcl_StaticPackage(3) +package(n), Tcl_StaticLibrary(3) diff --git a/doc/StaticLibrary.3 b/doc/StaticLibrary.3 new file mode 100644 index 0000000..83a9a07 --- /dev/null +++ b/doc/StaticLibrary.3 @@ -0,0 +1,78 @@ +'\" +'\" 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. +'\" +.TH Tcl_StaticLibrary 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros +.BS +.SH NAME +Tcl_StaticLibrary, Tcl_StaticPackage \- make a statically linked library available via the 'load' command +.SH SYNOPSIS +.nf +\fB#include <tcl.h>\fR +.sp +\fBTcl_StaticLibrary\fR(\fIinterp, prefix, initProc, safeInitProc\fR) +.sp +\fBTcl_StaticPackage\fR(\fIinterp, prefix, initProc, safeInitProc\fR) +.SH ARGUMENTS +.AS Tcl_LibraryInitProc *safeInitProc +.AP Tcl_Interp *interp in +If not NULL, points to an interpreter into which the library has +already been incorporated (i.e., the caller has already invoked the +appropriate initialization procedure). NULL means the library +has not yet been incorporated into any interpreter. +.AP "const char" *prefix in +Prefix for library initialization function. Normally in titlecase (first +letter upper-case, all others lower-case), but this is no longer required. +.AP Tcl_LibraryInitProc *initProc in +Procedure to invoke to incorporate this library into a trusted +interpreter. +.AP Tcl_LibraryInitProc *safeInitProc in +Procedure to call to incorporate this library into a safe interpreter +(one that will execute untrusted scripts). NULL means the library +cannot be used in safe interpreters. +.BE +.SH DESCRIPTION +.PP +This procedure may be invoked to announce that a library has been +linked statically with a Tcl application and, optionally, that it +has already been incorporated into an interpreter. +Once \fBTcl_StaticLibrary\fR has been invoked for a library, it +may be incorporated into interpreters using the \fBload\fR command. +\fBTcl_StaticLibrary\fR is normally invoked only by the \fBTcl_AppInit\fR +procedure for the application, not by libraries for themselves +(\fBTcl_StaticLibrary\fR should only be invoked for statically +linked libraries, and code in the library itself should not need +to know whether the library is dynamically loaded or statically linked). +.PP +When the \fBload\fR command is used later to incorporate the library into +an interpreter, one of \fIinitProc\fR and \fIsafeInitProc\fR will +be invoked, depending on whether the target interpreter is safe +or not. +\fIinitProc\fR and \fIsafeInitProc\fR must both match the +following prototype: +.PP +.CS +typedef int \fBTcl_LibraryInitProc\fR( + Tcl_Interp *\fIinterp\fR); +.CE +.PP +The \fIinterp\fR argument identifies the interpreter in which the library +is to be incorporated. The initialization procedure must return \fBTCL_OK\fR or +\fBTCL_ERROR\fR to indicate whether or not it completed successfully; in +the event of an error it should set the interpreter's result to point to an +error message. The result or error from the initialization procedure will +be returned as the result of the \fBload\fR command that caused the +initialization procedure to be invoked. +.PP +\fBTcl_StaticLibrary\fR was named \fBTcl_StaticPackage\fR in Tcl 8.6 and +earlier, but the old name is deprecated now. +.PP +\fBTcl_StaticLibrary\fR can not be safely used by stub-enabled extensions, +so its symbol is not included in the stub table. +.SH KEYWORDS +initialization procedure, package, static linking +.SH "SEE ALSO" +load(n), package(n), Tcl_PkgRequire(3) diff --git a/doc/StaticPkg.3 b/doc/StaticPkg.3 deleted file mode 100644 index 5931f61..0000000 --- a/doc/StaticPkg.3 +++ /dev/null @@ -1,73 +0,0 @@ -'\" -'\" 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. -'\" -.TH Tcl_StaticPackage 3 7.5 Tcl "Tcl Library Procedures" -.so man.macros -.BS -.SH NAME -Tcl_StaticPackage \- make a statically linked package available via the 'load' command -.SH SYNOPSIS -.nf -\fB#include <tcl.h>\fR -.sp -\fBTcl_StaticPackage\fR(\fIinterp, prefix, initProc, safeInitProc\fR) -.SH ARGUMENTS -.AS Tcl_PackageInitProc *safeInitProc -.AP Tcl_Interp *interp in -If not NULL, points to an interpreter into which the package has -already been loaded (i.e., the caller has already invoked the -appropriate initialization procedure). NULL means the package -has not yet been incorporated into any interpreter. -.AP "const char" *prefix in -Prefix for library initialization function; should be properly -capitalized (first letter upper-case, all others lower-case). -.AP Tcl_PackageInitProc *initProc in -Procedure to invoke to incorporate this package into a trusted -interpreter. -.AP Tcl_PackageInitProc *safeInitProc in -Procedure to call to incorporate this package into a safe interpreter -(one that will execute untrusted scripts). NULL means the package -cannot be used in safe interpreters. -.BE -.SH DESCRIPTION -.PP -This procedure may be invoked to announce that a package has been -linked statically with a Tcl application and, optionally, that it -has already been loaded into an interpreter. -Once \fBTcl_StaticPackage\fR has been invoked for a package, it -may be loaded into interpreters using the \fBload\fR command. -\fBTcl_StaticPackage\fR is normally invoked only by the \fBTcl_AppInit\fR -procedure for the application, not by packages for themselves -(\fBTcl_StaticPackage\fR should only be invoked for statically -loaded packages, and code in the package itself should not need -to know whether the package is dynamically or statically loaded). -.PP -When the \fBload\fR command is used later to load the package into -an interpreter, one of \fIinitProc\fR and \fIsafeInitProc\fR will -be invoked, depending on whether the target interpreter is safe -or not. -\fIinitProc\fR and \fIsafeInitProc\fR must both match the -following prototype: -.PP -.CS -typedef int \fBTcl_PackageInitProc\fR( - Tcl_Interp *\fIinterp\fR); -.CE -.PP -The \fIinterp\fR argument identifies the interpreter in which the package -is to be loaded. The initialization procedure must return \fBTCL_OK\fR or -\fBTCL_ERROR\fR to indicate whether or not it completed successfully; in -the event of an error it should set the interpreter's result to point to an -error message. The result or error from the initialization procedure will -be returned as the result of the \fBload\fR command that caused the -initialization procedure to be invoked. -.PP -\fBTcl_StaticPackage\fR can not be safely used by stub-enabled extensions, -so its symbol is not included in the stub table. -.SH KEYWORDS -initialization procedure, package, static linking -.SH "SEE ALSO" -load(n), package(n), Tcl_PkgRequire(3) @@ -38,17 +38,14 @@ Tcl interpreter. The name of the initialization procedure is determined by \fIprefix\fR and whether or not the target interpreter is a safe one. For normal interpreters the name of the initialization -procedure will have the form \fIpfx\fB_Init\fR, where \fIpfx\fR -is the same as \fIprefix\fR except that the first letter is -converted to upper case and all other letters -are converted to lower case. For example, if \fIprefix\fR is -\fBfoo\fR or \fBFOo\fR, the initialization procedure's name will +procedure will have the form \fIprefix\fB_Init\fR. For example, if +\fIprefix\fR is \fBFoo\fR, the initialization procedure's name will be \fBFoo_Init\fR. .PP If the target interpreter is a safe interpreter, then the name -of the initialization procedure will be \fIpfx\fB_SafeInit\fR -instead of \fIpfx\fB_Init\fR. -The \fIpfx\fB_SafeInit\fR function should be written carefully, so that it +of the initialization procedure will be \fIprefix\fB_SafeInit\fR +instead of \fIprefix\fB_Init\fR. +The \fIprefix\fB_SafeInit\fR function should be written carefully, so that it initializes the safe interpreter only with partial functionality provided by the library that is safe for use by untrusted code. For more information on Safe\-Tcl, see the \fBsafe\fR manual entry. @@ -56,7 +53,7 @@ on Safe\-Tcl, see the \fBsafe\fR manual entry. The initialization procedure must match the following prototype: .PP .CS -typedef int \fBTcl_PackageInitProc\fR( +typedef int \fBTcl_LibraryInitProc\fR( Tcl_Interp *\fIinterp\fR); .CE .PP @@ -79,18 +76,16 @@ Tcl's unloading mechanism. .PP The \fBload\fR command also supports libraries that are statically linked with the application, if those libraries have been registered -by calling the \fBTcl_StaticPackage\fR procedure. +by calling the \fBTcl_StaticLibrary\fR procedure. If \fIfileName\fR is an empty string, then \fIprefix\fR must be specified. .PP If \fIprefix\fR is omitted or specified as an empty string, -Tcl tries to guess the prefix. This may be done differently on -different platforms. The default guess, which is used on most -UNIX platforms, is to take the last element of +Tcl tries to guess the prefix by taking the last element of \fIfileName\fR, strip off the first three characters if they -are \fBlib\fR, then strip off the next three characters if they -are \fBtcl\fR, and use any following alphabetic and -underline characters, converted to titlecase as the prefix. +are \fBlib\fR, then strip off the next three characters if +they are \fBtcl9\fR, and use any following wordchars but not digits, +converted to titlecase as the prefix. For example, the command \fBload libxyz4.2.so\fR uses the prefix \fBXyz\fR and the command \fBload bin/last.so {}\fR uses the prefix \fBLast\fR. @@ -98,7 +93,7 @@ prefix \fBLast\fR. If \fIfileName\fR is an empty string, then \fIprefix\fR must be specified. The \fBload\fR command first searches for a statically loaded library -(one that has been registered by calling the \fBTcl_StaticPackage\fR +(one that has been registered by calling the \fBTcl_StaticLibrary\fR procedure) by that name; if one is found, it is used. Otherwise, the \fBload\fR command searches for a dynamically loaded library by that name, and uses it if it is found. If several @@ -188,7 +183,7 @@ switch $tcl_platform(platform) { foo .CE .SH "SEE ALSO" -info sharedlibextension, package(n), Tcl_StaticPackage(3), safe(n) +info sharedlibextension, package(n), Tcl_StaticLibrary(3), safe(n) .SH KEYWORDS binary code, dynamic library, load, safe interpreter, shared library '\"Local Variables: diff --git a/doc/unload.n b/doc/unload.n index adf4b2c..d5bbde8 100644 --- a/doc/unload.n +++ b/doc/unload.n @@ -90,7 +90,7 @@ detached from the process. The unload procedure must match the following prototype: .PP .CS -typedef int \fBTcl_PackageUnloadProc\fR( +typedef int \fBTcl_LibraryUnloadProc\fR( Tcl_Interp *\fIinterp\fR, int \fIflags\fR); .CE @@ -123,8 +123,8 @@ different platforms. The default guess, which is used on most UNIX platforms, is to take the last element of \fIfileName\fR, strip off the first three characters if they are \fBlib\fR, then strip off the next three characters if they -are \fBtcl\fR, and use any following alphabetic and -underline characters, converted to titlecase as the prefix. +are \fBtcl9\fR, and use any following wordchars but not digits, +converted to titlecase as the prefix. For example, the command \fBunload libxyz4.2.so\fR uses the prefix \fBXyz\fR and the command \fBunload bin/last.so {}\fR uses the prefix \fBLast\fR. diff --git a/generic/tcl.decls b/generic/tcl.decls index 6abd468..efc72cf 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -889,7 +889,7 @@ declare 243 { # Removed in 9.0 (stub entry only) #declare 244 { # void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix, -# Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc) +# Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc) #} # Removed in 9.0 (stub entry only) #declare 245 { @@ -1643,8 +1643,8 @@ declare 443 { } 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, + const char *sym2, Tcl_LibraryInitProc **proc1Ptr, + Tcl_LibraryInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr) } declare 445 { @@ -2511,10 +2511,6 @@ interface tclPlat # (none) ################################ -# Windows specific functions -# (none) - -################################ # Mac OS X specific functions declare 1 { @@ -2526,6 +2522,12 @@ declare 2 { void Tcl_MacOSXNotifierAddRunLoopMode(const void *runLoopMode) } +################################ +# Windows specific functions +declare 3 { + void Tcl_WinConvertError(unsigned errCode) +} + ############################################################################## # Public functions that are not accessible via the stubs table. @@ -2535,8 +2537,8 @@ export { Tcl_Interp *interp) } export { - void Tcl_StaticLibrary(Tcl_Interp *interp, const char *pkgName, - Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc) + void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix, + Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc) } export { void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc) diff --git a/generic/tcl.h b/generic/tcl.h index e4709b4..5ea74fc 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -556,8 +556,8 @@ typedef void (Tcl_InterpDeleteProc) (void *clientData, typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *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 int (Tcl_LibraryInitProc) (Tcl_Interp *interp); +typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan, char *address, int port); @@ -577,10 +577,11 @@ typedef void *(Tcl_InitNotifierProc) (void); typedef void (Tcl_FinalizeNotifierProc) (void *clientData); typedef void (Tcl_MainLoopProc) (void); -/* Undocumented. To be formalized by TIP #595 */ -#define Tcl_LibraryInitProc Tcl_PackageInitProc -#define Tcl_LibraryUnloadProc Tcl_PackageUnloadProc - +#ifndef TCL_NO_DEPRECATED +# define Tcl_PackageInitProc Tcl_LibraryInitProc +# define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc +#endif + /* *---------------------------------------------------------------------------- * The following structure represents a type of object, which is a particular @@ -2196,8 +2197,9 @@ EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); -/* Undocumented. To be formalized by TIP #595 */ +#ifndef TCL_NO_DEPRECATED # define Tcl_StaticPackage Tcl_StaticLibrary +#endif EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); #ifdef _WIN32 EXTERN int TclZipfs_AppHook(int *argc, wchar_t ***argv); diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b90e12d..911469b 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3435,6 +3435,8 @@ Tcl_DeleteCommandFromToken( if (cmdPtr->tracePtr != NULL) { CommandTrace *tracePtr; + /* Note that CallCommandTraces() never frees cmdPtr, that's + * done just before Tcl_DeleteCommandFromToken() returns */ CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); /* @@ -3663,6 +3665,8 @@ CallCommandTraces( cmdPtr->flags &= ~CMD_TRACE_ACTIVE; cmdPtr->refCount--; + /* Don't free cmdPtr here, since the caller of CallCommandTraces() + * is responsible for that. See Tcl_DeleteCommandFromToken() */ iPtr->activeCmdTracePtr = active.nextPtr; Tcl_Release(iPtr); return result; diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 2aded52..b582c81 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1150,8 +1150,8 @@ 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_LibraryInitProc **proc1Ptr, + Tcl_LibraryInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 445 */ @@ -2205,7 +2205,7 @@ typedef struct TclStubs { 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_FSLoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_LibraryInitProc **proc1Ptr, Tcl_LibraryInitProc **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 */ diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index df94367..f433781 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -3010,7 +3010,7 @@ Tcl_FSLoadFile( const char *sym1, const char *sym2, /* Names of two functions to find in the * dynamic shared object. */ - Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, + Tcl_LibraryInitProc **proc1Ptr, Tcl_LibraryInitProc **proc2Ptr, /* Places to store pointers to the functions * named by sym1 and sym2. */ Tcl_LoadHandle *handlePtr, /* A place to store the token for the loaded @@ -3028,8 +3028,8 @@ Tcl_FSLoadFile( res = Tcl_LoadFile(interp, pathPtr, symbols, 0, procPtrs, handlePtr); if (res == TCL_OK) { - *proc1Ptr = (Tcl_PackageInitProc *) procPtrs[0]; - *proc2Ptr = (Tcl_PackageInitProc *) procPtrs[1]; + *proc1Ptr = (Tcl_LibraryInitProc *) procPtrs[0]; + *proc2Ptr = (Tcl_LibraryInitProc *) procPtrs[1]; } else { *proc1Ptr = *proc2Ptr = NULL; } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index e3d9313..782ba0c 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -578,7 +578,7 @@ declare 256 { } declare 257 { void TclStaticLibrary(Tcl_Interp *interp, const char *prefix, - Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc) + Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc) } # TIP 431: temporary directory creation function @@ -598,9 +598,10 @@ interface tclIntPlat ################################ # Platform specific functions -declare 0 {unix win} { - void TclWinConvertError(int errCode) -} +# Removed in 9.0 +#declare 0 {unix win} { +# void TclWinConvertError(unsigned errCode) +#} declare 1 {unix win} { int TclpCloseFile(TclFile file) } diff --git a/generic/tclInt.h b/generic/tclInt.h index 8c9ddb1..ef457a9 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4729,7 +4729,7 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); *---------------------------------------------------------------------- */ -MODULE_SCOPE Tcl_PackageInitProc TclTommath_Init; +MODULE_SCOPE Tcl_LibraryInitProc TclTommath_Init; /* *---------------------------------------------------------------------- @@ -4741,11 +4741,11 @@ MODULE_SCOPE Tcl_PackageInitProc TclTommath_Init; *---------------------------------------------------------------------- */ -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; +MODULE_SCOPE Tcl_LibraryInitProc TclplatformtestInit; +MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init; +MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init; +MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init; +MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; /* *---------------------------------------------------------------- diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index eeb929e..ebd41b1 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -574,8 +574,8 @@ EXTERN int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, /* 257 */ EXTERN void TclStaticLibrary(Tcl_Interp *interp, const char *prefix, - Tcl_PackageInitProc *initProc, - Tcl_PackageInitProc *safeInitProc); + Tcl_LibraryInitProc *initProc, + Tcl_LibraryInitProc *safeInitProc); /* 258 */ EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj); @@ -841,7 +841,7 @@ typedef struct TclIntStubs { Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const 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, const int flags); /* 256 */ - void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */ + void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */ Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */ } TclIntStubs; diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index c8941e5..3f6ee7ee 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -41,8 +41,7 @@ extern "C" { */ #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ -/* 0 */ -EXTERN void TclWinConvertError(int errCode); +/* Slot 0 is reserved */ /* 1 */ EXTERN int TclpCloseFile(TclFile file); /* 2 */ @@ -108,8 +107,7 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *resultingNameObj); #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ -/* 0 */ -EXTERN void TclWinConvertError(int errCode); +/* Slot 0 is reserved */ /* 1 */ EXTERN int TclpCloseFile(TclFile file); /* 2 */ @@ -179,8 +177,7 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *resultingNameObj); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ -/* 0 */ -EXTERN void TclWinConvertError(int errCode); +/* Slot 0 is reserved */ /* 1 */ EXTERN int TclpCloseFile(TclFile file); /* 2 */ @@ -251,7 +248,7 @@ typedef struct TclIntPlatStubs { void *hooks; #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ - void (*tclWinConvertError) (int errCode); /* 0 */ + void (*reserved0)(void); 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 */ @@ -284,7 +281,7 @@ typedef struct TclIntPlatStubs { 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) (int errCode); /* 0 */ + void (*reserved0)(void); 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 */ @@ -317,7 +314,7 @@ typedef struct TclIntPlatStubs { int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - void (*tclWinConvertError) (int errCode); /* 0 */ + void (*reserved0)(void); 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 */ @@ -364,8 +361,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; */ #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ -#define TclWinConvertError \ - (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ +/* Slot 0 is reserved */ #define TclpCloseFile \ (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ #define TclpCreateCommandChannel \ @@ -419,8 +415,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ -#define TclWinConvertError \ - (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ +/* Slot 0 is reserved */ #define TclpCloseFile \ (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ #define TclpCreateCommandChannel \ @@ -477,8 +472,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ -#define TclWinConvertError \ - (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ +/* Slot 0 is reserved */ #define TclpCloseFile \ (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ #define TclpCreateCommandChannel \ @@ -538,7 +532,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#define TclWinConvertWSAError TclWinConvertError +#define TclWinConvertWSAError Tcl_WinConvertError +#define TclWinConvertError Tcl_WinConvertError #ifdef MAC_OSX_TCL /* not accessable on Win32/UNIX */ MODULE_SCOPE int TclMacOSXGetFileAttribute(Tcl_Interp *interp, diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 41f2e67..64f03a7 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -16,38 +16,34 @@ * The following structure describes a library that has been loaded either * dynamically (with the "load" command) or statically (as indicated by a call * to Tcl_StaticLibrary). All such libraries are linked together into a - * single list for the process. Library are never unloaded, until the - * application exits, when TclFinalizeLoad is called, and these structures are - * freed. + * single list for the process. */ typedef struct LoadedLibrary { char *fileName; /* Name of the file from which the library was * loaded. An empty string means the library * is loaded statically. Malloc-ed. */ - char *prefix; /* Prefix for the library, - * properly capitalized (first letter UC, - * others LC), as in "Net". + char *prefix; /* Prefix for the library. * 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; + Tcl_LibraryInitProc *initProc; /* Initialization function to call to * incorporate this library into a trusted * interpreter. */ - Tcl_PackageInitProc *safeInitProc; + Tcl_LibraryInitProc *safeInitProc; /* Initialization function to call to * incorporate this library into a safe * interpreter (one that will execute * untrusted scripts). NULL means the library * can't be used in unsafe interpreters. */ - Tcl_PackageUnloadProc *unloadProc; + Tcl_LibraryUnloadProc *unloadProc; /* Finalization function to unload a library * from a trusted interpreter. NULL means that * the library cannot be unloaded. */ - Tcl_PackageUnloadProc *safeUnloadProc; + Tcl_LibraryUnloadProc *safeUnloadProc; /* Finalization function to unload a library * from a safe interpreter. NULL means that * the library cannot be unloaded. */ @@ -127,7 +123,7 @@ Tcl_LoadObjCmd( InterpLibrary *ipFirstPtr, *ipPtr; int code, namesMatch, filesMatch, offset; const char *symbols[2]; - Tcl_PackageInitProc *initProc; + Tcl_LibraryInitProc *initProc; const char *p, *fullFileName, *prefix; Tcl_LoadHandle loadHandle; Tcl_UniChar ch = 0; @@ -226,8 +222,6 @@ Tcl_LoadObjCmd( Tcl_DStringAppend(&pfx, prefix, -1); TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1); - Tcl_UtfToLower(Tcl_DStringValue(&pfx)); - Tcl_UtfToLower(Tcl_DStringValue(&tmp)); if (strcmp(Tcl_DStringValue(&tmp), Tcl_DStringValue(&pfx)) == 0) { namesMatch = 1; @@ -313,7 +307,7 @@ Tcl_LoadObjCmd( /* * The platform-specific code couldn't figure out the prefix. * Make a guess by taking the last element of the file - * name, stripping off any leading "lib" and/or "tcl", and + * name, stripping off any leading "lib" and/or "tcl9", and * then using all of the alphabetic and underline characters * that follow that. */ @@ -331,15 +325,18 @@ Tcl_LoadObjCmd( pkgGuess += 3; } #endif /* __CYGWIN__ */ - if ((pkgGuess[0] == 't') && (pkgGuess[1] == 'c') - && (pkgGuess[2] == 'l')) { - pkgGuess += 3; + if (((pkgGuess[0] == 't') +#ifdef MAC_OS_TCL + || (pkgGuess[0] == 'T') +#endif + ) && (pkgGuess[1] == 'c') + && (pkgGuess[2] == 'l') && (pkgGuess[3] == '9')) { + pkgGuess += 4; } for (p = pkgGuess; *p != 0; p += offset) { offset = TclUtfToUniChar(p, &ch); - if ((ch > 0x100) - || !(isalpha(UCHAR(ch)) /* INTL: ISO only */ - || (UCHAR(ch) == '_'))) { + if (!Tcl_UniCharIsWordChar(UCHAR(ch)) + || Tcl_UniCharIsDigit(UCHAR(ch))) { break; } } @@ -355,16 +352,17 @@ Tcl_LoadObjCmd( } Tcl_DStringAppend(&pfx, pkgGuess, p - pkgGuess); Tcl_DecrRefCount(splitPtr); - } - /* - * Fix the capitalization in the prefix so that the first - * character is in caps (or title case) but the others are all - * lower-case. - */ + /* + * Fix the capitalization in the prefix so that the first + * character is in caps (or title case) but the others are all + * lower-case. + */ - Tcl_DStringSetLength(&pfx, - Tcl_UtfToTitle(Tcl_DStringValue(&pfx))); + Tcl_DStringSetLength(&pfx, + Tcl_UtfToTitle(Tcl_DStringValue(&pfx))); + + } /* * Compute the names of the two initialization functions, based on the @@ -409,13 +407,13 @@ Tcl_LoadObjCmd( memcpy(libraryPtr->prefix, Tcl_DStringValue(&pfx), len); libraryPtr->loadHandle = loadHandle; libraryPtr->initProc = initProc; - libraryPtr->safeInitProc = (Tcl_PackageInitProc *) + libraryPtr->safeInitProc = (Tcl_LibraryInitProc *) Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&safeInitName)); - libraryPtr->unloadProc = (Tcl_PackageUnloadProc *) + libraryPtr->unloadProc = (Tcl_LibraryUnloadProc *) Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&unloadName)); - libraryPtr->safeUnloadProc = (Tcl_PackageUnloadProc *) + libraryPtr->safeUnloadProc = (Tcl_LibraryUnloadProc *) Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&safeUnloadName)); libraryPtr->interpRefCount = 0; @@ -547,7 +545,7 @@ Tcl_UnloadObjCmd( Tcl_Interp *target; /* Which interpreter to unload from. */ LoadedLibrary *libraryPtr, *defaultPtr; Tcl_DString pfx, tmp; - Tcl_PackageUnloadProc *unloadProc; + Tcl_LibraryUnloadProc *unloadProc; InterpLibrary *ipFirstPtr, *ipPtr; int i, index, code, complain = 1, keepLibrary = 0; int trustedRefCount = -1, safeRefCount = -1; @@ -660,8 +658,6 @@ Tcl_UnloadObjCmd( Tcl_DStringAppend(&pfx, prefix, -1); TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1); - Tcl_UtfToLower(Tcl_DStringValue(&pfx)); - Tcl_UtfToLower(Tcl_DStringValue(&tmp)); if (strcmp(Tcl_DStringValue(&tmp), Tcl_DStringValue(&pfx)) == 0) { namesMatch = 1; @@ -942,13 +938,11 @@ Tcl_StaticLibrary( * 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, + const char *prefix, /* Prefix. */ + Tcl_LibraryInitProc *initProc, /* Function to call to incorporate this * library into a trusted interpreter. */ - Tcl_PackageInitProc *safeInitProc) + Tcl_LibraryInitProc *safeInitProc) /* Function to call to incorporate this * library into a safe interpreter (one that * will execute untrusted scripts). NULL means diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index f9d38ef..871a2d3 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -68,6 +68,8 @@ EXTERN int Tcl_MacOSXOpenVersionedBundleResources( /* 2 */ EXTERN void Tcl_MacOSXNotifierAddRunLoopMode( const void *runLoopMode); +/* 3 */ +EXTERN void Tcl_WinConvertError(unsigned errCode); typedef struct TclPlatStubs { int magic; @@ -76,6 +78,7 @@ typedef struct TclPlatStubs { void (*reserved0)(void); int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 1 */ void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */ + void (*tcl_WinConvertError) (unsigned errCode); /* 3 */ } TclPlatStubs; extern const TclPlatStubs *tclPlatStubsPtr; @@ -95,6 +98,8 @@ extern const TclPlatStubs *tclPlatStubsPtr; (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ #define Tcl_MacOSXNotifierAddRunLoopMode \ (tclPlatStubsPtr->tcl_MacOSXNotifierAddRunLoopMode) /* 2 */ +#define Tcl_WinConvertError \ + (tclPlatStubsPtr->tcl_WinConvertError) /* 3 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index cf6c63a..ea158b2 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -67,6 +67,11 @@ #undef Tcl_UtfToUniCharDString #undef Tcl_UtfToUniChar #define TclUnusedStubEntry 0 +#if !defined(_WIN32) && !defined(__CYGWIN__) +#undef Tcl_WinConvertError +#define Tcl_WinConvertError 0 +#endif + #if TCL_UTF_MAX <= 3 static void uniCodePanic() { @@ -267,7 +272,6 @@ static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ #else /* __CYGWIN__ */ # define TclWinGetTclInstance (void *(*)(void))(void *)TclpCreateProcess # define TclpGetPid (size_t(*)(Tcl_Pid))(void *)TclUnixWaitForFile -# define TclWinConvertError (void(*)(int))(void *)TclGetAndDetachPids # define TclWinFlushDirtyChannels 0 # define TclWinNoBackslash 0 # define TclWinAddProcess 0 @@ -561,7 +565,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, 0, #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ - TclWinConvertError, /* 0 */ + 0, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ @@ -594,7 +598,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclUnixOpenTemporaryFile, /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ - TclWinConvertError, /* 0 */ + 0, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ @@ -627,7 +631,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclUnixOpenTemporaryFile, /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - TclWinConvertError, /* 0 */ + 0, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ @@ -667,6 +671,7 @@ static const TclPlatStubs tclPlatStubs = { 0, /* 0 */ Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ Tcl_MacOSXNotifierAddRunLoopMode, /* 2 */ + Tcl_WinConvertError, /* 3 */ }; const TclTomMathStubs tclTomMathStubs = { diff --git a/generic/tclTest.c b/generic/tclTest.c index eecfa25..e644755 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -274,7 +274,7 @@ static Tcl_CmdProc Testset2Cmd; static Tcl_CmdProc TestseterrorcodeCmd; static Tcl_ObjCmdProc TestsetobjerrorcodeCmd; static Tcl_CmdProc TestsetplatformCmd; -static Tcl_CmdProc TeststaticpkgCmd; +static Tcl_CmdProc TeststaticlibraryCmd; static Tcl_CmdProc TesttranslatefilenameCmd; static Tcl_CmdProc TestupvarCmd; static Tcl_ObjCmdProc TestWrongNumArgsObjCmd; @@ -601,7 +601,7 @@ Tcltest_Init( NULL, NULL); Tcl_CreateCommand(interp, "testsocket", TestSocketCmd, NULL, NULL); - Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd, + Tcl_CreateCommand(interp, "teststaticlibrary", TeststaticlibraryCmd, NULL, NULL); Tcl_CreateCommand(interp, "testtranslatefilename", TesttranslatefilenameCmd, NULL, NULL); @@ -4217,9 +4217,9 @@ TestsetplatformCmd( /* *---------------------------------------------------------------------- * - * TeststaticpkgCmd -- + * TeststaticlibraryCmd -- * - * This procedure implements the "teststaticpkg" command. + * This procedure implements the "teststaticlibrary" command. * It is used to test the procedure Tcl_StaticLibrary. * * Results: @@ -4233,7 +4233,7 @@ TestsetplatformCmd( */ static int -TeststaticpkgCmd( +TeststaticlibraryCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index dbe6171..5c42af4 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -1854,7 +1854,7 @@ ZipfsSetup(void) Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS); ZipFS.idCount = 1; ZipFS.wrmax = DEFAULT_WRITE_MAX_SIZE; - ZipFS.fallbackEntryEncoding = + ZipFS.fallbackEntryEncoding = (char *) Tcl_Alloc(strlen(ZIPFS_FALLBACK_ENCODING) + 1); strcpy(ZipFS.fallbackEntryEncoding, ZIPFS_FALLBACK_ENCODING); ZipFS.utf8 = Tcl_GetEncoding(NULL, "utf-8"); diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl index 5d1727d..18ac517 100644 --- a/library/dde/pkgIndex.tcl +++ b/library/dde/pkgIndex.tcl @@ -1,3 +1,12 @@ -if {![package vsatisfies [package provide Tcl] 8.5-]} return if {[info sharedlibextension] != ".dll"} return -package ifneeded dde 1.4.4 [list load [file join $dir tcldde14.dll] Dde] +if {[package vsatisfies [package provide Tcl] 9.0-]} { + package ifneeded dde 1.4.4 \ + [list load [file join $dir tcl9dde14.dll] Dde] +} elseif {![package vsatisfies [package provide Tcl] 8.7] + && [::tcl::pkgconfig get debug]} { + package ifneeded dde 1.4.4 \ + [list load [file join $dir tcldde14g.dll] Dde] +} else { + package ifneeded dde 1.4.4 \ + [list load [file join $dir tcldde14.dll] Dde] +} diff --git a/library/registry/pkgIndex.tcl b/library/registry/pkgIndex.tcl index 5c73f30..765f02a 100644 --- a/library/registry/pkgIndex.tcl +++ b/library/registry/pkgIndex.tcl @@ -1,4 +1,9 @@ if {![package vsatisfies [package provide Tcl] 8.5-]} return if {[info sharedlibextension] != ".dll"} return -package ifneeded registry 1.3.6 \ - [list load [file join $dir tclregistry13.dll] Registry] +if {[package vsatisfies [package provide Tcl] 9.0-]} { + package ifneeded registry 1.3.6 \ + [list load [file join $dir tcl9registry13.dll] Registry] +} else { + package ifneeded registry 1.3.6 \ + [list load [file join $dir tclregistry13.dll] Registry] +} diff --git a/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj index a0690111..fd75ac3 100644 --- a/macosx/Tcl.xcode/project.pbxproj +++ b/macosx/Tcl.xcode/project.pbxproj @@ -394,7 +394,7 @@ F96D3EA208F272A7004A47F5 /* split.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = split.n; sourceTree = "<group>"; }; F96D3EA308F272A7004A47F5 /* SplitList.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitList.3; sourceTree = "<group>"; }; F96D3EA408F272A7004A47F5 /* SplitPath.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitPath.3; sourceTree = "<group>"; }; - F96D3EA508F272A7004A47F5 /* StaticPkg.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticPkg.3; sourceTree = "<group>"; }; + F96D3EA508F272A7004A47F5 /* StaticLibrary.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticLibrary.3; sourceTree = "<group>"; }; F96D3EA608F272A7004A47F5 /* StdChannels.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StdChannels.3; sourceTree = "<group>"; }; F96D3EA708F272A7004A47F5 /* string.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = string.n; sourceTree = "<group>"; }; F96D3EA808F272A7004A47F5 /* StringObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StringObj.3; sourceTree = "<group>"; }; @@ -1141,7 +1141,7 @@ F96D3EA208F272A7004A47F5 /* split.n */, F96D3EA308F272A7004A47F5 /* SplitList.3 */, F96D3EA408F272A7004A47F5 /* SplitPath.3 */, - F96D3EA508F272A7004A47F5 /* StaticPkg.3 */, + F96D3EA508F272A7004A47F5 /* StaticLibrary.3 */, F96D3EA608F272A7004A47F5 /* StdChannels.3 */, F96D3EA708F272A7004A47F5 /* string.n */, F96D3EA808F272A7004A47F5 /* StringObj.3 */, diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj index 2b08bf9..8d67cc6 100644 --- a/macosx/Tcl.xcodeproj/project.pbxproj +++ b/macosx/Tcl.xcodeproj/project.pbxproj @@ -393,7 +393,7 @@ F96D3EA208F272A7004A47F5 /* split.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = split.n; sourceTree = "<group>"; }; F96D3EA308F272A7004A47F5 /* SplitList.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitList.3; sourceTree = "<group>"; }; F96D3EA408F272A7004A47F5 /* SplitPath.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitPath.3; sourceTree = "<group>"; }; - F96D3EA508F272A7004A47F5 /* StaticPkg.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticPkg.3; sourceTree = "<group>"; }; + F96D3EA508F272A7004A47F5 /* StaticLibrary.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticLibrary.3; sourceTree = "<group>"; }; F96D3EA608F272A7004A47F5 /* StdChannels.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StdChannels.3; sourceTree = "<group>"; }; F96D3EA708F272A7004A47F5 /* string.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = string.n; sourceTree = "<group>"; }; F96D3EA808F272A7004A47F5 /* StringObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StringObj.3; sourceTree = "<group>"; }; @@ -1141,7 +1141,7 @@ F96D3EA208F272A7004A47F5 /* split.n */, F96D3EA308F272A7004A47F5 /* SplitList.3 */, F96D3EA408F272A7004A47F5 /* SplitPath.3 */, - F96D3EA508F272A7004A47F5 /* StaticPkg.3 */, + F96D3EA508F272A7004A47F5 /* StaticLibrary.3 */, F96D3EA608F272A7004A47F5 /* StdChannels.3 */, F96D3EA708F272A7004A47F5 /* string.n */, F96D3EA808F272A7004A47F5 /* StringObj.3 */, diff --git a/tests/load.test b/tests/load.test index 1ee2bf5..c419bfb 100644 --- a/tests/load.test +++ b/tests/load.test @@ -36,9 +36,9 @@ testConstraint $loaded [expr {![string match *pkga* $alreadyLoaded]}] set alreadyTotalLoaded [info loaded] -# Certain tests require the 'teststaticpkg' command from tcltest +# Certain tests require the 'teststaticlibrary' command from tcltest -testConstraint teststaticpkg [llength [info commands teststaticpkg]] +testConstraint teststaticlibrary [llength [info commands teststaticlibrary]] # Test load-10.1 requires the 'testsimplefilesystem' command from tcltest @@ -150,78 +150,78 @@ test load-6.1 {errors loading file} [list $dll $loaded] { catch {load foo foo} } {1} -test load-7.1 {Tcl_StaticPackage procedure} [list teststaticpkg] { +test load-7.1 {Tcl_StaticLibrary procedure} [list teststaticlibrary] { set x "not loaded" - teststaticpkg Test 1 0 + teststaticlibrary 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] { +test load-7.2 {Tcl_StaticLibrary procedure} [list teststaticlibrary] { set x "not loaded" - teststaticpkg Another 0 0 + teststaticlibrary 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 library in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded} -test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] { +test load-7.3 {Tcl_StaticLibrary procedure} [list teststaticlibrary] { set x "not loaded" - teststaticpkg More 0 1 + teststaticlibrary 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 +set currentRealLibraries [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_StaticLibrary procedure, redundant calls} -setup { + teststaticlibrary Test 1 0 + teststaticlibrary Another 0 0 + teststaticlibrary More 0 1 +} -constraints [list teststaticlibrary $dll $loaded] -body { + teststaticlibrary Double 0 1 + teststaticlibrary Double 0 1 info loaded -} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded] +} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealLibraries {*}$alreadyTotalLoaded] -testConstraint teststaticpkg_8.x 0 -if {[testConstraint teststaticpkg]} { +testConstraint teststaticlibrary_8.x 0 +if {[testConstraint teststaticlibrary]} { catch { - teststaticpkg Test 1 1 - teststaticpkg Another 0 1 - teststaticpkg More 0 1 - teststaticpkg Double 0 1 - testConstraint teststaticpkg_8.x 1 + teststaticlibrary Test 1 1 + teststaticlibrary Another 0 1 + teststaticlibrary More 0 1 + teststaticlibrary Double 0 1 + testConstraint teststaticlibrary_8.x 1 } } -test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] { +test load-8.1 {TclGetLoadedLibraries procedure} [list teststaticlibrary_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 { +} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealLibraries {*}$alreadyTotalLoaded]] +test load-8.2 {TclGetLoadedLibraries procedure} -constraints {teststaticlibrary_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] { +test load-8.3a {TclGetLoadedLibraries procedure} [list teststaticlibrary_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] { +test load-8.3b {TclGetLoadedLibraries procedure} [list teststaticlibrary_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] { +test load-8.4 {TclGetLoadedLibraries procedure} [list teststaticlibrary_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 { +test load-9.1 {Tcl_StaticLibrary, 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 } +} -constraints {teststaticlibrary} -body { + child1 eval { teststaticlibrary Loadninepointone 0 1 } + child2 eval { teststaticlibrary Loadninepointone 0 1 } list [child1 eval { info loaded {} }] \ [child2 eval { info loaded {} }] } -match glob -cleanup { diff --git a/tests/safe.test b/tests/safe.test index 8fca594..f3a6565 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -1159,7 +1159,7 @@ test safe-9.24 {interpConfigure change the access path; check module loading; st res0 res1 res2} # See comments on lsort after test safe-9.20. -catch {teststaticpkg Safepfx1 0 0} +catch {teststaticlibrary Safepfx1 0 0} test safe-10.1 {testing statics loading} -constraints tcl::test -setup { set i [safe::interpCreate] } -body { diff --git a/tools/tsdPerf.c b/tools/tsdPerf.c index 7a599e0..4c96f28 100644 --- a/tools/tsdPerf.c +++ b/tools/tsdPerf.c @@ -1,6 +1,6 @@ #include <tcl.h> -extern DLLEXPORT Tcl_PackageInitProc Tsdperf_Init; +extern DLLEXPORT Tcl_LibraryInitProc Tsdperf_Init; static Tcl_ThreadDataKey key; diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in index 500bf97..bb80783 100644 --- a/unix/dltest/Makefile.in +++ b/unix/dltest/Makefile.in @@ -25,13 +25,16 @@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \ ${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS} -all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX} pkgooa${SHLIB_SUFFIX} +all: tcl9pkgπ${SHLIB_SUFFIX} tcl9pkga${SHLIB_SUFFIX} tcl9pkgb${SHLIB_SUFFIX} tcl9pkgc${SHLIB_SUFFIX} tcl9pkgd${SHLIB_SUFFIX} tcl9pkge${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} tcl9pkgooa${SHLIB_SUFFIX} @if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi @touch ../dltest.marker -dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX} pkgooa${DLTEST_SUFFIX} +dltest_suffix: tcl9pkgπ${DLTEST_SUFFIX} tcl9pkga${DLTEST_SUFFIX} tcl9pkgb${DLTEST_SUFFIX} tcl9pkgc${DLTEST_SUFFIX} tcl9pkgd${DLTEST_SUFFIX} tcl9pkge${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} tcl9pkgooa${DLTEST_SUFFIX} @touch ../dltest.marker +pkgπ.o: $(SRC_DIR)/pkgπ.c + $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgπ.c + pkga.o: $(SRC_DIR)/pkga.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c @@ -53,47 +56,53 @@ pkgua.o: $(SRC_DIR)/pkgua.c pkgooa.o: $(SRC_DIR)/pkgooa.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c -pkga${SHLIB_SUFFIX}: pkga.o - ${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o ${SHLIB_LD_LIBS} +tcl9pkgπ${SHLIB_SUFFIX}: pkgπ.o + ${SHLIB_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS} + +tcl9pkga${SHLIB_SUFFIX}: pkga.o + ${SHLIB_LD} -o $@ pkga.o ${SHLIB_LD_LIBS} + +tcl9pkgb${SHLIB_SUFFIX}: pkgb.o + ${SHLIB_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS} -pkgb${SHLIB_SUFFIX}: pkgb.o - ${SHLIB_LD} -o pkgb${SHLIB_SUFFIX} pkgb.o ${SHLIB_LD_LIBS} +tcl9pkgc${SHLIB_SUFFIX}: pkgc.o + ${SHLIB_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS} -pkgc${SHLIB_SUFFIX}: pkgc.o - ${SHLIB_LD} -o pkgc${SHLIB_SUFFIX} pkgc.o ${SHLIB_LD_LIBS} +tcl9pkgd${SHLIB_SUFFIX}: pkgd.o + ${SHLIB_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS} -pkgd${SHLIB_SUFFIX}: pkgd.o - ${SHLIB_LD} -o pkgd${SHLIB_SUFFIX} pkgd.o ${SHLIB_LD_LIBS} +tcl9pkge${SHLIB_SUFFIX}: pkge.o + ${SHLIB_LD} -o $@ pkge.o ${SHLIB_LD_LIBS} -pkge${SHLIB_SUFFIX}: pkge.o - ${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o ${SHLIB_LD_LIBS} +tcl9pkgua${SHLIB_SUFFIX}: pkgua.o + ${SHLIB_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS} -pkgua${SHLIB_SUFFIX}: pkgua.o - ${SHLIB_LD} -o pkgua${SHLIB_SUFFIX} pkgua.o ${SHLIB_LD_LIBS} +tcl9pkgooa${SHLIB_SUFFIX}: pkgooa.o + ${SHLIB_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS} -pkgooa${SHLIB_SUFFIX}: pkgooa.o - ${SHLIB_LD} -o pkgooa${SHLIB_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS} +tcl9pkgπ${DLTEST_SUFFIX}: pkgπ.o + ${DLTEST_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS} -pkga${DLTEST_SUFFIX}: pkga.o - ${DLTEST_LD} -o pkga${DLTEST_SUFFIX} pkga.o ${SHLIB_LD_LIBS} +tcl9pkga${DLTEST_SUFFIX}: pkga.o + ${DLTEST_LD} -o $@ pkga.o ${SHLIB_LD_LIBS} -pkgb${DLTEST_SUFFIX}: pkgb.o - ${DLTEST_LD} -o pkgb${DLTEST_SUFFIX} pkgb.o ${SHLIB_LD_LIBS} +tcl9pkgb${DLTEST_SUFFIX}: pkgb.o + ${DLTEST_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS} -pkgc${DLTEST_SUFFIX}: pkgc.o - ${DLTEST_LD} -o pkgc${DLTEST_SUFFIX} pkgc.o ${SHLIB_LD_LIBS} +tcl9pkgc${DLTEST_SUFFIX}: pkgc.o + ${DLTEST_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS} -pkgd${DLTEST_SUFFIX}: pkgd.o - ${DLTEST_LD} -o pkgd${DLTEST_SUFFIX} pkgd.o ${SHLIB_LD_LIBS} +tcl9pkgd${DLTEST_SUFFIX}: pkgd.o + ${DLTEST_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS} -pkge${DLTEST_SUFFIX}: pkge.o - ${DLTEST_LD} -o pkge${DLTEST_SUFFIX} pkge.o ${SHLIB_LD_LIBS} +tcl9pkge${DLTEST_SUFFIX}: pkge.o + ${DLTEST_LD} -o $@ pkge.o ${SHLIB_LD_LIBS} -pkgua${DLTEST_SUFFIX}: pkgua.o - ${DLTEST_LD} -o pkgua${DLTEST_SUFFIX} pkgua.o ${SHLIB_LD_LIBS} +tcl9pkgua${DLTEST_SUFFIX}: pkgua.o + ${DLTEST_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS} -pkgooa${DLTEST_SUFFIX}: pkgooa.o - ${DLTEST_LD} -o pkgooa${DLTEST_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS} +tcl9pkgooa${DLTEST_SUFFIX}: pkgooa.o + ${DLTEST_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS} clean: rm -f *.o lib.exp ../dltest.marker diff --git a/unix/dltest/pkgπ.c b/unix/dltest/pkgπ.c new file mode 100644 index 0000000..1cf95cf --- /dev/null +++ b/unix/dltest/pkgπ.c @@ -0,0 +1,95 @@ +/* + * pkgπ.c -- + * + * This file contains a simple Tcl package "pkgπ" that is intended for + * testing the Tcl dynamic loading facilities. + * + * Copyright © 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" + +/* + * Prototypes for procedures defined later in this file: + */ + +static int Pkg\u03C0_\u03A0ObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); + +/* + *---------------------------------------------------------------------- + * + * 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 +Pkg\u03C0_\u03A0ObjCmd( + void *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 != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(3.14159)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Pkgπ_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 +Pkg\u03C0_Init( + Tcl_Interp *interp) /* Interpreter in which the package is to be + * made available. */ +{ + int code; + + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { + return TCL_ERROR; + } + code = Tcl_PkgProvide(interp, "pkgπ", "1.0"); + if (code != TCL_OK) { + return code; + } + Tcl_CreateObjCommand(interp, "π", Pkg\u03C0_\u03A0ObjCmd, NULL, NULL); + return TCL_OK; +} diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 3587f35..f3caae7 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -15,15 +15,19 @@ #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_PackageInitProc Tcltest_Init; -extern Tcl_PackageInitProc Tcltest_SafeInit; +extern Tcl_LibraryInitProc Tcltest_Init; +extern Tcl_LibraryInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ #ifdef TCL_XT_TEST extern void XtToolkitInitialize(void); -extern Tcl_PackageInitProc Tclxttest_Init; +extern Tcl_LibraryInitProc Tclxttest_Init; #endif /* TCL_XT_TEST */ /* @@ -79,7 +83,8 @@ main( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); -#else +#elif !defined(_WIN32) || defined(UNICODE) + /* This doesn't work on Windows without UNICODE */ TclZipfs_AppHook(&argc, &argv); #endif @@ -124,7 +129,7 @@ Tcl_AppInit( if (Tcltest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); + Tcl_StaticLibrary(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); #endif /* TCL_TEST */ /* diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index effee69..24240af 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -336,7 +336,7 @@ FindSymbol( const char *symbol) /* Symbol name to look up. */ { Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *)loadHandle->clientData; - Tcl_PackageInitProc *proc = NULL; + Tcl_LibraryInitProc *proc = NULL; const char *errMsg = NULL; Tcl_DString ds; const char *native; @@ -344,7 +344,7 @@ FindSymbol( native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds); if (dyldLoadHandle->dlHandle) { #if TCL_DYLD_USE_DLFCN - proc = (Tcl_PackageInitProc *)dlsym(dyldLoadHandle->dlHandle, native); + proc = (Tcl_LibraryInitProc *)dlsym(dyldLoadHandle->dlHandle, native); if (!proc) { errMsg = dlerror(); } @@ -400,7 +400,7 @@ FindSymbol( dyldLoadHandle->modulePtr->module, native); } if (nsSymbol) { - proc = (Tcl_PackageInitProc *)NSAddressOfSymbol(nsSymbol); + proc = (Tcl_LibraryInitProc *)NSAddressOfSymbol(nsSymbol); } Tcl_DStringFree(&newName); #endif /* TCL_DYLD_USE_NSMODULE */ diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index 3dbf24d..c50e5aa 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -133,7 +133,7 @@ FindSymbol( Tcl_LoadHandle loadHandle, const char *symbol) { - Tcl_PackageInitProc *proc = NULL; + Tcl_LibraryInitProc *proc = NULL; if (symbol) { char sym[strlen(symbol) + 2]; diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index df8ed37..bc49de2 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -89,7 +89,7 @@ TclpDlopen( */ native = Tcl_FSGetNativePath(pathPtr); - lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS); + lm = (Tcl_LibraryInitProc *) load(native, LDR_NOFLAGS); if (lm == LDR_NULL_MODULE) { /* @@ -101,7 +101,7 @@ TclpDlopen( Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); - lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS); + lm = (Tcl_LibraryInitProc *) load(native, LDR_NOFLAGS); Tcl_DStringFree(&ds); } diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c index c6f8d98..ad75a91 100644 --- a/unix/tclLoadShl.c +++ b/unix/tclLoadShl.c @@ -128,7 +128,7 @@ FindSymbol( const char *symbol) { Tcl_DString newName; - Tcl_PackageInitProc *proc = NULL; + Tcl_LibraryInitProc *proc = NULL; shl_t handle = (shl_t) loadHandle->clientData; /* diff --git a/unix/tclSelectNotfy.c b/unix/tclSelectNotfy.c index e1d577f..1103dd2 100644 --- a/unix/tclSelectNotfy.c +++ b/unix/tclSelectNotfy.c @@ -377,7 +377,7 @@ TclpInitNotifier(void) void TclpFinalizeNotifier( - ClientData clientData) + TCL_UNUSED(void *)) { #if TCL_THREADS ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index adcbabb..7602709 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -2356,7 +2356,7 @@ StatError( Tcl_Obj *fileName) /* The name of the file which caused the * error. */ { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 0be9ed4..c1f00d5 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -211,7 +211,7 @@ LookUpFileHandler( void TclpSetTimer( - const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ + TCL_UNUSED(const Tcl_Time *)) /* Timeout value, may be NULL. */ { /* * The interval timer doesn't do anything in this implementation, because diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c index afac493..4ee7cca 100644 --- a/unix/tclXtTest.c +++ b/unix/tclXtTest.c @@ -16,7 +16,7 @@ #include "tcl.h" static Tcl_ObjCmdProc TesteventloopCmd; -extern DLLEXPORT Tcl_PackageInitProc Tclxttest_Init; +extern DLLEXPORT Tcl_LibraryInitProc Tclxttest_Init; /* * Functions defined in tclXtNotify.c for use by users of the Xt Notifier: diff --git a/win/Makefile.in b/win/Makefile.in index 1ace421..48b6021 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -148,9 +148,9 @@ TCL_VFS_ROOT = libtcl.vfs 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_DLL_FILE = tcl9dde$(DDEVER)${DLLSUFFIX} DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX} -REG_DLL_FILE = tclregistry$(REGVER)${DLLSUFFIX} +REG_DLL_FILE = tcl9registry$(REGVER)${DLLSUFFIX} REG_LIB_FILE = @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX} TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} TEST_EXE_FILE = tcltest${EXESUFFIX} diff --git a/win/makefile.vc b/win/makefile.vc index e090e28..2c984de 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -206,10 +206,10 @@ DDEVERSION = $(DDEDOTVERSION:.=) REGDOTVERSION = 1.3
REGVERSION = $(REGDOTVERSION:.=)
-TCLREGLIBNAME = $(PROJECT)registry$(REGVERSION)$(SUFX:t=).$(EXT)
+TCLREGLIBNAME = $(PROJECT)9registry$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME)
-TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
+TCLDDELIBNAME = $(PROJECT)9dde$(DDEVERSION)$(SUFX:t=).$(EXT)
TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe
diff --git a/win/rules.vc b/win/rules.vc index 2ec5292..85c37f2 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -1203,9 +1203,16 @@ TCLSH_NATIVE = $(TCLSH) !if $(DOING_TK) || $(NEED_TK)
WISHNAMEPREFIX = wish
WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe
-TKLIBNAME = $(PROJECT)$(TK_VERSION)$(SUFX).$(EXT)
-TKSTUBLIBNAME = tkstub$(TK_VERSION).lib
+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)
diff --git a/win/tcl.dsp b/win/tcl.dsp index 574623d..cea5115 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -824,7 +824,7 @@ SOURCE=..\doc\SplitPath.3 # End Source File
# Begin Source File
-SOURCE=..\doc\StaticPkg.3
+SOURCE=..\doc\StaticLibrary.3
# End Source File
# Begin Source File
diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 50a9f51..67218fd 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -23,16 +23,20 @@ #include <locale.h> #include <stdlib.h> #include <tchar.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_PackageInitProc Tcltest_Init; -extern Tcl_PackageInitProc Tcltest_SafeInit; +extern Tcl_LibraryInitProc Tcltest_Init; +extern Tcl_LibraryInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ #if defined(STATIC_BUILD) -extern Tcl_PackageInitProc Registry_Init; -extern Tcl_PackageInitProc Dde_Init; -extern Tcl_PackageInitProc Dde_SafeInit; +extern Tcl_LibraryInitProc Registry_Init; +extern Tcl_LibraryInitProc Dde_Init; +extern Tcl_LibraryInitProc Dde_SafeInit; #endif #if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS) @@ -168,19 +172,19 @@ Tcl_AppInit( if (Registry_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Registry", Registry_Init, NULL); + Tcl_StaticLibrary(interp, "Registry", Registry_Init, NULL); if (Dde_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Dde", Dde_Init, Dde_SafeInit); + Tcl_StaticLibrary(interp, "Dde", Dde_Init, Dde_SafeInit); #endif #ifdef TCL_TEST if (Tcltest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); + Tcl_StaticLibrary(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); #endif /* TCL_TEST */ /* diff --git a/win/tclWinChan.c b/win/tclWinChan.c index e8b3051..5ccaaf6 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -413,7 +413,7 @@ FileCloseProc( && (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle) && (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) { if (CloseHandle(fileInfoPtr->handle) == FALSE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); errorCode = errno; } } @@ -486,7 +486,7 @@ FileWideSeekProc( DWORD winError = GetLastError(); if (winError != NO_ERROR) { - TclWinConvertError(winError); + Tcl_WinConvertError(winError); *errorCodePtr = errno; return -1; } @@ -529,7 +529,7 @@ FileTruncateProc( DWORD winError = GetLastError(); if (winError != NO_ERROR) { - TclWinConvertError(winError); + Tcl_WinConvertError(winError); return errno; } } @@ -545,7 +545,7 @@ FileTruncateProc( DWORD winError = GetLastError(); if (winError != NO_ERROR) { - TclWinConvertError(winError); + Tcl_WinConvertError(winError); return errno; } } @@ -556,7 +556,7 @@ FileTruncateProc( */ if (!SetEndOfFile(infoPtr->handle)) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return errno; } @@ -616,7 +616,7 @@ FileInputProc( return bytesRead; } - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); *errorCode = errno; if (errno == EPIPE) { return 0; @@ -665,7 +665,7 @@ FileOutputProc( if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); *errorCode = errno; return -1; } @@ -840,7 +840,7 @@ TclpOpenFileChannel( if (NativeIsComPort(nativeName)) { handle = TclWinSerialOpen(INVALID_HANDLE_VALUE, nativeName, accessMode); if (handle == INVALID_HANDLE_VALUE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open serial \"%s\": %s", @@ -897,7 +897,7 @@ TclpOpenFileChannel( err = TEST_FLAG(mode, O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND; } - TclWinConvertError(err); + Tcl_WinConvertError(err); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open \"%s\": %s", @@ -921,7 +921,7 @@ TclpOpenFileChannel( handle = TclWinSerialOpen(handle, nativeName, accessMode); if (handle == INVALID_HANDLE_VALUE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't reopen serial \"%s\": %s", diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 04ea5fb..409890b 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -602,7 +602,7 @@ ConsoleCloseProc( && (GetStdHandle(STD_OUTPUT_HANDLE) != consolePtr->handle) && (GetStdHandle(STD_ERROR_HANDLE) != consolePtr->handle))) { if (CloseHandle(consolePtr->handle) == FALSE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); errorCode = errno; } } @@ -772,7 +772,7 @@ ConsoleOutputProc( */ if (infoPtr->writeError) { - TclWinConvertError(infoPtr->writeError); + Tcl_WinConvertError(infoPtr->writeError); infoPtr->writeError = 0; goto error; } @@ -807,7 +807,7 @@ ConsoleOutputProc( if (WriteConsoleBytes(infoPtr->handle, buf, (DWORD) toWrite, &bytesWritten) == FALSE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); goto error; } } @@ -1065,7 +1065,7 @@ WaitForRead( * Check to see if the peek failed because of EOF. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (errno == EOF) { infoPtr->readFlags |= CONSOLE_EOF; @@ -1477,7 +1477,7 @@ ConsoleSetOptionProc( DWORD mode; if (GetConsoleMode(infoPtr->handle, &mode) == 0) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read console mode: %s", @@ -1509,7 +1509,7 @@ ConsoleSetOptionProc( return TCL_ERROR; } if (SetConsoleMode(infoPtr->handle, mode) == 0) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't set console mode: %s", @@ -1589,7 +1589,7 @@ ConsoleGetOptionProc( valid = 1; if (GetConsoleMode(infoPtr->handle, &mode) == 0) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read console mode: %s", @@ -1620,7 +1620,7 @@ ConsoleGetOptionProc( valid = 1; if (!GetConsoleScreenBufferInfo(infoPtr->handle, &consoleInfo)) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read console size: %s", diff --git a/win/tclWinError.c b/win/tclWinError.c index 11828db..3e75a85 100644 --- a/win/tclWinError.c +++ b/win/tclWinError.c @@ -334,7 +334,7 @@ static const unsigned char wsaErrorTable[] = { /* *---------------------------------------------------------------------- * - * TclWinConvertError -- + * Tcl_WinConvertError -- * * This routine converts a Win32 error into an errno value. * @@ -348,8 +348,8 @@ static const unsigned char wsaErrorTable[] = { */ void -TclWinConvertError( - int errCode) /* Win32 error code. */ +Tcl_WinConvertError( + unsigned errCode) /* Win32 error code. */ { if ((unsigned)errCode >= sizeof(errorTable)/sizeof(errorTable[0])) { errCode -= WSAEWOULDBLOCK; diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 5d3d16d..dc67c45 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -279,7 +279,7 @@ DoRenameFile( return retval; } - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); srcAttr = GetFileAttributesW(nativeSrc); dstAttr = GetFileAttributesW(nativeDst); @@ -420,7 +420,7 @@ DoRenameFile( * be, but report this one. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); CreateDirectoryW(nativeDst, NULL); SetFileAttributesW(nativeDst, dstAttr); if (Tcl_GetErrno() == EACCES) { @@ -488,7 +488,7 @@ DoRenameFile( * error. Could happen if an open file refers to dst. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { /* * Decode the EACCES to a more meaningful error. @@ -669,7 +669,7 @@ DoCopyFile( return retval; } - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (Tcl_GetErrno() == EBADF) { Tcl_SetErrno(EACCES); return TCL_ERROR; @@ -706,7 +706,7 @@ DoCopyFile( * attributes of dst. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); SetFileAttributesW(nativeDst, dstAttr); } } @@ -766,7 +766,7 @@ TclpDeleteFile( if (DeleteFileW(path) != FALSE) { return TCL_OK; } - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { attr = GetFileAttributesW(path); @@ -797,7 +797,7 @@ TclpDeleteFile( (DeleteFileW(path) != FALSE)) { return TCL_OK; } - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (res != 0) { SetFileAttributesW(path, attr); } @@ -866,7 +866,7 @@ DoCreateDirectory( if (CreateDirectoryW(nativePath, NULL) == 0) { DWORD error = GetLastError(); - TclWinConvertError(error); + Tcl_WinConvertError(error); return TCL_ERROR; } return TCL_OK; @@ -1054,7 +1054,7 @@ DoRemoveJustDirectory( } } - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { attr = GetFileAttributesW(nativePath); @@ -1088,7 +1088,7 @@ DoRemoveJustDirectory( if (RemoveDirectoryW(nativePath) != FALSE) { return TCL_OK; } - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); SetFileAttributesW(nativePath, attr | FILE_ATTRIBUTE_READONLY); } @@ -1235,7 +1235,7 @@ TraverseWinTree( * Can't read directory. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); nativeErrfile = nativeSource; goto end; } @@ -1329,7 +1329,7 @@ TraverseWinTree( end: if (nativeErrfile != NULL) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (errorPtr != NULL) { Tcl_DStringInit(errorPtr); Tcl_WCharToUtfDString(nativeErrfile, -1, errorPtr); @@ -1384,7 +1384,7 @@ TraversalCopy( attr) != FALSE) { return TCL_OK; } - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); } break; case DOTREE_POSTD: @@ -1482,7 +1482,7 @@ StatError( Tcl_Obj *fileName) /* The name of the file which caused the * error. */ { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } @@ -2067,7 +2067,7 @@ TclpCreateTemporaryDirectory( */ if (error != ERROR_SUCCESS) { - TclWinConvertError(error); + Tcl_WinConvertError(error); Tcl_DStringFree(&base); return NULL; } diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 676ae38..e4dd665 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -209,7 +209,7 @@ WinLink( * Invalid file. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return -1; } @@ -233,7 +233,7 @@ WinLink( * Invalid file. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return -1; } @@ -247,7 +247,7 @@ WinLink( * The target doesn't exist. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * It is a file. @@ -262,7 +262,7 @@ WinLink( return 0; } - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); } else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { if (CreateSymbolicLinkW(linkSourcePath, linkTargetPath, 0x2 /* SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE */)) { @@ -272,7 +272,7 @@ WinLink( return 0; } else { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); } } else { Tcl_SetErrno(ENODEV); @@ -327,7 +327,7 @@ WinReadLink( * Invalid file. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return NULL; } @@ -341,7 +341,7 @@ WinReadLink( * The source doesn't exist. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return NULL; } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { @@ -502,7 +502,7 @@ TclWinSymLinkDelete( * Error setting junction. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); CloseHandle(hFile); } else { CloseHandle(hFile); @@ -695,7 +695,7 @@ NativeReadReparse( * Error creating directory. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return -1; } @@ -709,7 +709,7 @@ NativeReadReparse( * Error setting junction. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); CloseHandle(hFile); return -1; } @@ -751,7 +751,7 @@ NativeWriteReparse( * Error creating directory. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return -1; } hFile = CreateFileW(linkDirPath, GENERIC_WRITE, 0, NULL, @@ -762,7 +762,7 @@ NativeWriteReparse( * Error creating directory. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return -1; } @@ -777,7 +777,7 @@ NativeWriteReparse( * Error setting junction. */ - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); CloseHandle(hFile); RemoveDirectoryW(linkDirPath); return -1; @@ -1038,7 +1038,7 @@ TclpMatchInDirectory( return TCL_OK; } - TclWinConvertError(err); + Tcl_WinConvertError(err); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read directory \"%s\": %s", @@ -1587,7 +1587,7 @@ NativeAccess( DWORD lasterror = GetLastError(); if (lasterror != ERROR_SHARING_VIOLATION) { - TclWinConvertError(lasterror); + Tcl_WinConvertError(lasterror); return -1; } } @@ -1713,7 +1713,7 @@ NativeAccess( * to EACCES - just what we want! */ - TclWinConvertError((DWORD) error); + Tcl_WinConvertError((DWORD) error); return -1; } @@ -1818,7 +1818,7 @@ NativeAccess( */ accessError: - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (sdPtr != NULL) { HeapFree(GetProcessHeap(), 0, sdPtr); } @@ -1913,7 +1913,7 @@ TclpObjChdir( result = SetCurrentDirectoryW(nativePath); if (result == 0) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return -1; } return 0; @@ -1952,7 +1952,7 @@ TclpGetCwd( WCHAR *native; if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error getting working directory name: %s", @@ -2117,12 +2117,12 @@ NativeStat( DWORD lasterror = GetLastError(); if (lasterror != ERROR_SHARING_VIOLATION) { - TclWinConvertError(lasterror); + Tcl_WinConvertError(lasterror); return -1; } hFind = FindFirstFileW(nativePath, &ffd); if (hFind == INVALID_HANDLE_VALUE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return -1; } memcpy(&data, &ffd, sizeof(data)); @@ -2351,7 +2351,7 @@ TclpGetNativeCwd( WCHAR buffer[MAX_PATH]; if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return NULL; } @@ -3251,7 +3251,7 @@ TclpUtime( if (fileHandle == INVALID_HANDLE_VALUE || !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); res = -1; } if (fileHandle != INVALID_HANDLE_VALUE) { diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index e3bb3ae..ac2b3bf 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -159,7 +159,7 @@ TclpDlopen( Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", -1); break; default: - TclWinConvertError(lastError); + Tcl_WinConvertError(lastError); Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), -1); } Tcl_SetObjResult(interp, errMsg); @@ -379,7 +379,7 @@ InitDLLDirectoryName(void) id *= 16777619; } - TclWinConvertError(lastError); + Tcl_WinConvertError(lastError); return TCL_ERROR; /* diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index db75237..0b4c506 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -581,46 +581,6 @@ Tcl_Sleep( } /* - *---------------------------------------------------------------------- - * - * TclpCreateFileHandler, TclpDeleteFileHandler -- - * - * Stub functions for strictly POSIX-only functionality that panic with a - * failure message; they simply don't work at all on Windows so using - * them on the platform is always a programming bug. - * - * Results: - * None. - * - * Side effects: - * The process will terminate, violently. - * - *---------------------------------------------------------------------- - */ - -void -TclpCreateFileHandler( - 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. */ -{ - Tcl_Panic("Tcl_CreateFileHandler not supported on this platform"); -} - -void -Tcl_DeleteFileHandler( - int fd) /* Stream id for which to remove callback - * function. */ -{ - Tcl_Panic("Tcl_DeleteFileHandler not supported on this platform"); -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 60e421d..baef81e 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -549,7 +549,7 @@ TclpOpenFile( accessMode = (GENERIC_READ | GENERIC_WRITE); break; default: - TclWinConvertError(ERROR_INVALID_FUNCTION); + Tcl_WinConvertError(ERROR_INVALID_FUNCTION); return NULL; } @@ -613,7 +613,7 @@ TclpOpenFile( if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) { err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND; } - TclWinConvertError(err); + Tcl_WinConvertError(err); return NULL; } @@ -719,7 +719,7 @@ TclpCreateTempFile( Tcl_DStringFree(&dstring); } - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); CloseHandle(handle); DeleteFileW(name); return NULL; @@ -784,7 +784,7 @@ TclpCreatePipe( return 1; } - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return 0; } @@ -825,7 +825,7 @@ TclpCloseFile( && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) { if (filePtr->handle != NULL && CloseHandle(filePtr->handle) == FALSE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_Free(filePtr); return -1; } @@ -1026,7 +1026,7 @@ TclpCreateProcess( 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdInput == INVALID_HANDLE_VALUE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't duplicate input handle: %s", Tcl_PosixError(interp))); @@ -1055,7 +1055,7 @@ TclpCreateProcess( &startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't duplicate output handle: %s", Tcl_PosixError(interp))); @@ -1075,7 +1075,7 @@ TclpCreateProcess( 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdError == INVALID_HANDLE_VALUE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't duplicate error handle: %s", Tcl_PosixError(interp))); @@ -1137,7 +1137,7 @@ TclpCreateProcess( if (CreateProcessW(NULL, (WCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", argv[0], Tcl_PosixError(interp))); goto end; @@ -1387,7 +1387,7 @@ ApplicationType( Tcl_DStringFree(&nameBuf); if (applType == APPL_NONE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", originalName, Tcl_PosixError(interp))); return APPL_NONE; @@ -1866,7 +1866,7 @@ Tcl_CreatePipe( sec.bInheritHandle = FALSE; if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "pipe creation failed: %s", Tcl_PosixError(interp))); return TCL_ERROR; @@ -2224,7 +2224,7 @@ PipeInputProc( return bytesRead; } - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); if (errno == EPIPE) { infoPtr->readFlags |= PIPE_EOF; return 0; @@ -2283,7 +2283,7 @@ PipeOutputProc( */ if (infoPtr->writeError) { - TclWinConvertError(infoPtr->writeError); + Tcl_WinConvertError(infoPtr->writeError); infoPtr->writeError = 0; goto error; } @@ -2318,7 +2318,7 @@ PipeOutputProc( if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); goto error; } } @@ -2850,7 +2850,7 @@ WaitForRead( if (PeekNamedPipe(handle, (LPVOID) NULL, (DWORD) 0, (LPDWORD) NULL, &count, (LPDWORD) NULL) != TRUE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); /* * Check to see if the peek failed because of EOF. @@ -3261,7 +3261,7 @@ TclpOpenTemporaryFile( TCL_READABLE|TCL_WRITABLE); gotError: - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return NULL; } diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index f601fa9..220b47b 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -645,7 +645,7 @@ SerialCloseProc( && (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle) && (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) { if (CloseHandle(serialPtr->handle) == FALSE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); errorCode = errno; } } @@ -928,7 +928,7 @@ SerialInputProc( if (SerialBlockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead, &infoPtr->osRead) == FALSE) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); *errorCode = errno; return -1; } @@ -1010,7 +1010,7 @@ SerialOutputProc( */ if (infoPtr->writeError) { - TclWinConvertError(infoPtr->writeError); + Tcl_WinConvertError(infoPtr->writeError); infoPtr->writeError = 0; goto error1; } @@ -1069,7 +1069,7 @@ SerialOutputProc( return (int) bytesWritten; writeError: - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); error: /* @@ -1936,7 +1936,7 @@ SerialSetOptionProc( if (!SetupComm(infoPtr->handle, inSize, outSize)) { if (interp != NULL) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't setup comm buffers: %s", Tcl_PosixError(interp))); @@ -1987,7 +1987,7 @@ SerialSetOptionProc( tout.ReadTotalTimeoutConstant = msec; if (!SetCommTimeouts(infoPtr->handle, &tout)) { if (interp != NULL) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't set comm timeouts: %s", Tcl_PosixError(interp))); @@ -2004,7 +2004,7 @@ SerialSetOptionProc( getStateFailed: if (interp != NULL) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get comm state: %s", Tcl_PosixError(interp))); } @@ -2012,7 +2012,7 @@ SerialSetOptionProc( setStateFailed: if (interp != NULL) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't set comm state: %s", Tcl_PosixError(interp))); } @@ -2095,7 +2095,7 @@ SerialGetOptionProc( if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get comm state: %s", Tcl_PosixError(interp))); } @@ -2165,7 +2165,7 @@ SerialGetOptionProc( if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get comm state: %s", Tcl_PosixError(interp))); } @@ -2243,7 +2243,7 @@ SerialGetOptionProc( if (!GetCommModemStatus(infoPtr->handle, &status)) { if (interp != NULL) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get tty status: %s", Tcl_PosixError(interp))); } diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 8990a03..61c1010 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -878,7 +878,7 @@ TcpInputProc( if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING) || (error != WSAEWOULDBLOCK)) { - TclWinConvertError(error); + Tcl_WinConvertError(error); *errorCodePtr = Tcl_GetErrno(); bytesRead = -1; break; @@ -992,7 +992,7 @@ TcpOutputProc( break; } } else { - TclWinConvertError(error); + Tcl_WinConvertError(error); *errorCodePtr = Tcl_GetErrno(); written = -1; break; @@ -1060,7 +1060,7 @@ TcpCloseProc( statePtr->sockets = thisfd->next; if (closesocket(thisfd->fd) == SOCKET_ERROR) { - TclWinConvertError((DWORD) WSAGetLastError()); + Tcl_WinConvertError((DWORD) WSAGetLastError()); errorCode = Tcl_GetErrno(); } Tcl_Free(thisfd); @@ -1150,11 +1150,11 @@ TcpClose2Proc( */ if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) { - TclWinConvertError((DWORD) WSAGetLastError()); + Tcl_WinConvertError((DWORD) WSAGetLastError()); readError = Tcl_GetErrno(); } if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) { - TclWinConvertError((DWORD) WSAGetLastError()); + Tcl_WinConvertError((DWORD) WSAGetLastError()); writeError = Tcl_GetErrno(); } return (readError != 0) ? readError : writeError; @@ -1221,7 +1221,7 @@ TcpSetOptionProc( rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (const char *) &val, sizeof(BOOL)); if (rtn != 0) { - TclWinConvertError(WSAGetLastError()); + Tcl_WinConvertError(WSAGetLastError()); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't set socket option: %s", @@ -1243,7 +1243,7 @@ TcpSetOptionProc( rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (const char *) &val, sizeof(BOOL)); if (rtn != 0) { - TclWinConvertError(WSAGetLastError()); + Tcl_WinConvertError(WSAGetLastError()); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't set socket option: %s", @@ -1378,7 +1378,7 @@ TcpGetOptionProc( */ if (err) { - TclWinConvertError(err); + Tcl_WinConvertError(err); Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1); } @@ -1448,7 +1448,7 @@ TcpGetOptionProc( */ if (len) { - TclWinConvertError((DWORD) WSAGetLastError()); + Tcl_WinConvertError((DWORD) WSAGetLastError()); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get peername: %s", @@ -1524,7 +1524,7 @@ TcpGetOptionProc( Tcl_DStringEndSublist(dsPtr); } else { if (interp) { - TclWinConvertError((DWORD) WSAGetLastError()); + Tcl_WinConvertError((DWORD) WSAGetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't get sockname: %s", Tcl_PosixError(interp))); } @@ -1776,7 +1776,7 @@ TcpConnect( */ if (statePtr->sockets->fd == INVALID_SOCKET) { - TclWinConvertError((DWORD) WSAGetLastError()); + Tcl_WinConvertError((DWORD) WSAGetLastError()); continue; } @@ -1801,7 +1801,7 @@ TcpConnect( if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr, statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) { - TclWinConvertError((DWORD) WSAGetLastError()); + Tcl_WinConvertError((DWORD) WSAGetLastError()); continue; } @@ -1872,7 +1872,7 @@ TcpConnect( statePtr->addr->ai_addrlen); error = WSAGetLastError(); - TclWinConvertError(error); + Tcl_WinConvertError(error); if (async_connect && error == WSAEWOULDBLOCK) { /* @@ -1904,7 +1904,7 @@ TcpConnect( * Get signaled connect error. */ - TclWinConvertError((DWORD) statePtr->notifierConnectError); + Tcl_WinConvertError((DWORD) statePtr->notifierConnectError); /* * Clear eventual connect flag. @@ -2233,7 +2233,7 @@ Tcl_OpenTcpServerEx( sock = socket(addrPtr->ai_family, addrPtr->ai_socktype, addrPtr->ai_protocol); if (sock == INVALID_SOCKET) { - TclWinConvertError((DWORD) WSAGetLastError()); + Tcl_WinConvertError((DWORD) WSAGetLastError()); continue; } @@ -2284,7 +2284,7 @@ Tcl_OpenTcpServerEx( if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen) == SOCKET_ERROR) { - TclWinConvertError((DWORD) WSAGetLastError()); + Tcl_WinConvertError((DWORD) WSAGetLastError()); closesocket(sock); continue; } @@ -2309,7 +2309,7 @@ Tcl_OpenTcpServerEx( */ if (listen(sock, SOMAXCONN) == SOCKET_ERROR) { - TclWinConvertError((DWORD) WSAGetLastError()); + Tcl_WinConvertError((DWORD) WSAGetLastError()); closesocket(sock); continue; } @@ -2494,7 +2494,7 @@ InitSockets(void) windowClass.hCursor = NULL; if (!RegisterClassW(&windowClass)) { - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); goto initFailure; } } diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 5f36c85..48a22ce 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -206,7 +206,7 @@ TestvolumetypeCmd( if (found == 0) { Tcl_AppendResult(interp, "could not get volume type for \"", (path?path:""), "\"", NULL); - TclWinConvertError(GetLastError()); + Tcl_WinConvertError(GetLastError()); return TCL_ERROR; } Tcl_AppendResult(interp, volType, NULL); |