summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/RegConfig.38
-rw-r--r--doc/StaticPkg.38
-rw-r--r--doc/load.n71
-rw-r--r--doc/packagens.n2
-rw-r--r--doc/re_syntax.n4
-rw-r--r--doc/unload.n37
-rw-r--r--generic/tcl.decls2
-rw-r--r--generic/tcl.h2
-rw-r--r--generic/tclCmdIL.c2
-rw-r--r--generic/tclConfig.c2
-rw-r--r--generic/tclEncoding.c285
-rw-r--r--generic/tclEvent.c2
-rw-r--r--generic/tclIORChan.c3
-rw-r--r--generic/tclIndexObj.c2
-rw-r--r--generic/tclInt.decls2
-rw-r--r--generic/tclInt.h2
-rw-r--r--generic/tclIntDecls.h4
-rw-r--r--generic/tclLoad.c582
-rw-r--r--generic/tclPkgConfig.c2
-rw-r--r--generic/tclTest.c2
-rw-r--r--generic/tclThreadAlloc.c2
-rw-r--r--generic/tclZipfs.c307
-rw-r--r--library/safe.tcl24
-rw-r--r--tests/load.test38
-rw-r--r--tests/safe.test32
-rw-r--r--tests/unload.test20
-rw-r--r--tests/zipfs.test5
-rw-r--r--tools/README14
28 files changed, 761 insertions, 705 deletions
diff --git a/doc/RegConfig.3 b/doc/RegConfig.3
index d73e3d7..ef46ba5 100644
--- a/doc/RegConfig.3
+++ b/doc/RegConfig.3
@@ -28,7 +28,7 @@ configuration as ASCII string. This means that this information is in
UTF-8 too. Must not be NULL.
.AP "const Tcl_Config" *configuration in
Refers to an array of Tcl_Config entries containing the information
-embedded in the binary library. Must not be NULL. The end of the array
+embedded in the library. Must not be NULL. The end of the array
is signaled by either a key identical to NULL, or a key referring to
the empty string.
.AP "const char" *valEncoding in
@@ -40,10 +40,10 @@ too. Must not be NULL.
.PP
The function described here has its base in TIP 59 and provides
extensions with support for the embedding of configuration
-information into their binary library and the generation of a
+information into their library and the generation of a
Tcl-level interface for querying this information.
.PP
-To embed configuration information into their binary library an
+To embed configuration information into their library an
extension has to define a non-volatile array of Tcl_Config entries in
one if its source files and then call \fBTcl_RegisterConfig\fR to
register that information.
@@ -108,4 +108,4 @@ typedef struct Tcl_Config {
.\" No cross references yet.
.\" .SH "SEE ALSO"
.SH KEYWORDS
-embedding, configuration, binary library
+embedding, configuration, library
diff --git a/doc/StaticPkg.3 b/doc/StaticPkg.3
index a28652e..5931f61 100644
--- a/doc/StaticPkg.3
+++ b/doc/StaticPkg.3
@@ -13,7 +13,7 @@ Tcl_StaticPackage \- make a statically linked package available via the 'load' c
.nf
\fB#include <tcl.h>\fR
.sp
-\fBTcl_StaticPackage\fR(\fIinterp, pkgName, initProc, safeInitProc\fR)
+\fBTcl_StaticPackage\fR(\fIinterp, prefix, initProc, safeInitProc\fR)
.SH ARGUMENTS
.AS Tcl_PackageInitProc *safeInitProc
.AP Tcl_Interp *interp in
@@ -21,9 +21,9 @@ 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" *pkgName in
-Name of the package; should be properly capitalized (first letter
-upper-case, all others lower-case).
+.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.
diff --git a/doc/load.n b/doc/load.n
index 1185e1e..265a9fa 100644
--- a/doc/load.n
+++ b/doc/load.n
@@ -13,22 +13,21 @@ load \- Load machine code and initialize new commands
.SH SYNOPSIS
\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName\fR
.br
-\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName\fR
+\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName prefix\fR
.br
-\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName interp\fR
+\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName prefix interp\fR
.BE
.SH DESCRIPTION
.PP
This command loads binary code from a file into the
application's address space and calls an initialization procedure
-in the package to incorporate it into an interpreter. \fIfileName\fR
+in the library to incorporate it into an interpreter. \fIfileName\fR
is the name of the file containing the code; its exact form varies
from system to system but on most systems it is a shared library,
such as a \fB.so\fR file under Solaris or a DLL under Windows.
-\fIpackageName\fR is the name of the package, and is used to
-compute the name of an initialization procedure.
+\fIprefix\fR is used to compute the name of an initialization procedure.
\fIinterp\fR is the path name of the interpreter into which to load
-the package (see the \fBinterp\fR manual entry for details);
+the library (see the \fBinterp\fR manual entry for details);
if \fIinterp\fR is omitted, it defaults to the
interpreter in which the \fBload\fR command was invoked.
.PP
@@ -37,21 +36,21 @@ one of two initialization procedures will be invoked in the new code.
Typically the initialization procedure will add new commands to a
Tcl interpreter.
The name of the initialization procedure is determined by
-\fIpackageName\fR and whether or not the target interpreter
+\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 \fIpkg\fB_Init\fR, where \fIpkg\fR
-is the same as \fIpackageName\fR except that the first letter is
+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 \fIpackageName\fR is
+are converted to lower case. For example, if \fIprefix\fR is
\fBfoo\fR or \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 \fIpkg\fB_SafeInit\fR
-instead of \fIpkg\fB_Init\fR.
-The \fIpkg\fB_SafeInit\fR function should be written carefully, so that it
+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
initializes the safe interpreter only with partial functionality provided
-by the package that is safe for use by untrusted code. For more information
+by the library that is safe for use by untrusted code. For more information
on Safe\-Tcl, see the \fBsafe\fR manual entry.
.PP
The initialization procedure must match the following prototype:
@@ -62,7 +61,7 @@ typedef int \fBTcl_PackageInitProc\fR(
.CE
.PP
The \fIinterp\fR argument identifies the interpreter in which the
-package is to be loaded. The initialization procedure must return
+library 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 of the \fBload\fR command
@@ -74,37 +73,37 @@ interpreters, then the first \fBload\fR will load the code and
call the initialization procedure; subsequent \fBload\fRs will
call the initialization procedure without loading the code again.
For Tcl versions lower than 8.5, it is not possible to unload or reload a
-package. From version 8.5 however, the \fBunload\fR command allows the unloading
+library. From version 8.5 however, the \fBunload\fR command allows the unloading
of libraries loaded with \fBload\fR, for libraries that are aware of the
Tcl's unloading mechanism.
.PP
-The \fBload\fR command also supports packages that are statically
-linked with the application, if those packages have been registered
+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.
-If \fIfileName\fR is an empty string, then \fIpackageName\fR must
+If \fIfileName\fR is an empty string, then \fIprefix\fR must
be specified.
.PP
-If \fIpackageName\fR is omitted or specified as an empty string,
-Tcl tries to guess the name of the package.
-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 \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 as the module name.
-For example, the command \fBload libtclxyz4.2.so\fR uses the module
-name \fBxyz\fR and the command \fBload bin/last.so {}\fR uses the
-module name \fBlast\fR.
-.PP
-If \fIfileName\fR is an empty string, then \fIpackageName\fR must
+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
+\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.
+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.
+.PP
+If \fIfileName\fR is an empty string, then \fIprefix\fR must
be specified.
-The \fBload\fR command first searches for a statically loaded package
+The \fBload\fR command first searches for a statically loaded library
(one that has been registered by calling the \fBTcl_StaticPackage\fR
procedure) by that name; if one is found, it is used.
Otherwise, the \fBload\fR command searches for a dynamically loaded
-package by that name, and uses it if it is found. If several
+library by that name, and uses it if it is found. If several
different files have been \fBload\fRed with different versions of
-the package, Tcl picks the file that was loaded first.
+the library, Tcl picks the file that was loaded first.
.PP
If \fB\-global\fR is specified preceding the filename, all symbols
found in the shared library are exported for global use by other
@@ -112,7 +111,7 @@ libraries. The option \fB\-lazy\fR delays the actual loading of
symbols until their first actual use. The options may be abbreviated.
The option \fB\-\-\fR indicates the end of the options, and should
be used if you wish to use a filename which starts with \fB\-\fR
-and you provide a packageName to the \fBload\fR command.
+and you provide a prefix to the \fBload\fR command.
.PP
On platforms which do not support the \fB\-global\fR or \fB\-lazy\fR
options, the options still exist but have no effect. Note that use
diff --git a/doc/packagens.n b/doc/packagens.n
index 65535ef..d55151f 100644
--- a/doc/packagens.n
+++ b/doc/packagens.n
@@ -29,7 +29,7 @@ This parameter specifies the name of the package. It is required.
This parameter specifies the version of the package. It is required.
.TP
\fB\-load \fIfilespec\fR
-This parameter specifies a binary library that must be loaded with the
+This parameter specifies a library that must be loaded with the
\fBload\fR command. \fIfilespec\fR is a list with two elements. The
first element is the name of the file to load. The second, optional
element is a list of commands supplied by loading that file. If the
diff --git a/doc/re_syntax.n b/doc/re_syntax.n
index 62bb4af..f68135e 100644
--- a/doc/re_syntax.n
+++ b/doc/re_syntax.n
@@ -446,7 +446,7 @@ commonly-used character classes:
.TP
\fB\ew\fR
.
-\fB[[:alnum:]_]\fR (note underscore)
+\fB[[:alnum:]_\eu203F\eu2040\eu2054\euFE33\euFE34\euFE4D\euFE4E\euFE4F\euFF3F]\fR (including punctuation connector characters)
.TP
\fB\eD\fR
.
@@ -458,7 +458,7 @@ commonly-used character classes:
.TP
\fB\eW\fR
.
-\fB[^[:alnum:]_]\fR (note underscore)
+\fB[^[:alnum:]_\eu203F\eu2040\eu2054\euFE33\euFE34\euFE4D\euFE4E\euFE4F\euFF3F]\fR (including punctuation connector characters)
.RE
.PP
Within bracket expressions,
diff --git a/doc/unload.n b/doc/unload.n
index 0a8e99b..adf4b2c 100644
--- a/doc/unload.n
+++ b/doc/unload.n
@@ -13,9 +13,9 @@ unload \- Unload machine code
.SH SYNOPSIS
\fBunload \fR?\fIswitches\fR? \fIfileName\fR
.br
-\fBunload \fR?\fIswitches\fR? \fIfileName packageName\fR
+\fBunload \fR?\fIswitches\fR? \fIfileName prefix\fR
.br
-\fBunload \fR?\fIswitches\fR? \fIfileName packageName interp\fR
+\fBunload \fR?\fIswitches\fR? \fIfileName prefix interp\fR
.BE
.SH DESCRIPTION
.PP
@@ -24,7 +24,7 @@ with \fBload\fR from the application's address space. \fIfileName\fR
is the name of the file containing the library file to be unload; it
must be the same as the filename provided to \fBload\fR for
loading the library.
-The \fIpackageName\fR argument is the name of the package (as
+The \fIprefix\fR argument is the prefix (as
determined by or passed to \fBload\fR), and is used to
compute the name of the unload procedure; if not supplied, it is
computed from \fIfileName\fR in the same manner as \fBload\fR.
@@ -66,12 +66,12 @@ proper reference count.
\fBunload\fR works in the opposite direction. As a first step, \fBunload\fR
will check whether the library is unloadable: an unloadable library exports
a special unload procedure. The name of the unload procedure is determined by
-\fIpackageName\fR and whether or not the target interpreter
+\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 \fIpkg\fB_Unload\fR, where \fIpkg\fR
-is the same as \fIpackageName\fR except that the first letter is
+procedure will have the form \fIpfx\fB_Unload\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 \fIpackageName\fR is
+are converted to lower case. For example, if \fIprefix\fR is
\fBfoo\fR or \fBFOo\fR, the initialization procedure's name will
be \fBFoo_Unload\fR.
If the target interpreter is a safe interpreter, then the name
@@ -114,19 +114,20 @@ the \fIflags\fR argument will be set to \fBTCL_UNLOAD_DETACH_FROM_PROCESS\fR.
.PP
The \fBunload\fR command cannot unload libraries that are statically
linked with the application.
-If \fIfileName\fR is an empty string, then the \fIpackageName\fR argument must
+If \fIfileName\fR is an empty string, then the \fIprefix\fR argument must
be specified.
.PP
-If \fIpackageName\fR is omitted or specified as an empty string,
-Tcl tries to guess the name of the package.
-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 \fIfileName\fR, strip off the first
-three characters if they are \fBlib\fR, and use any following
-alphabetic and underline characters as the module name.
-For example, the command \fBunload libxyz4.2.so\fR uses the module
-name \fBxyz\fR and the command \fBunload bin/last.so {}\fR uses the
-module name \fBlast\fR.
+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
+\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.
+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.
.SH "PORTABILITY ISSUES"
.TP
\fBUnix\fR\0\0\0\0\0
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 9aae5dc..bd175d6 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -888,7 +888,7 @@ declare 243 {
}
# Removed in 9.0 (stub entry only)
#declare 244 {
-# void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
+# void Tcl_StaticPackage(Tcl_Interp *interp, const char *prefix,
# Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
#}
# Removed in 9.0 (stub entry only)
diff --git a/generic/tcl.h b/generic/tcl.h
index 5c6e35b..1ae0785 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2189,7 +2189,7 @@ EXTERN void Tcl_FindExecutable(const char *argv0);
EXTERN void Tcl_SetPanicProc(
TCL_NORETURN1 Tcl_PanicProc *panicProc);
EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
- const char *pkgName,
+ const char *prefix,
Tcl_PackageInitProc *initProc,
Tcl_PackageInitProc *safeInitProc);
EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 75eb441..64ba829 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1699,7 +1699,7 @@ InfoLoadedCmd(
} else { /* Get pkgs just in specified interp. */
packageName = TclGetString(objv[2]);
}
- return TclGetLoadedPackagesEx(interp, interpName, packageName);
+ return TclGetLoadedLibraries(interp, interpName, packageName);
}
/*
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index 85e05e9..09b1b27 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -178,7 +178,7 @@ Tcl_RegisterConfig(
* QueryConfigObjCmd --
*
* Implementation of "::<package>::pkgconfig", the command to query
- * configuration information embedded into a binary library.
+ * configuration information embedded into a library.
*
* Results:
* A standard tcl result.
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 2601614..1bc1360 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -220,14 +220,7 @@ static size_t unilen(const char *src);
static Tcl_EncodingConvertProc Utf16ToUtfProc;
static Tcl_EncodingConvertProc UtfToUtf16Proc;
static Tcl_EncodingConvertProc UtfToUcs2Proc;
-static int UtfToUtfProc(ClientData clientData,
- const char *src, int srcLen, int flags,
- Tcl_EncodingState *statePtr, char *dst,
- int dstLen, int *srcReadPtr,
- int *dstWrotePtr, int *dstCharsPtr,
- int pureNullMode);
-static Tcl_EncodingConvertProc UtfIntToUtfExtProc;
-static Tcl_EncodingConvertProc UtfExtToUtfIntProc;
+static Tcl_EncodingConvertProc UtfToUtfProc;
static Tcl_EncodingConvertProc Iso88591FromUtfProc;
static Tcl_EncodingConvertProc Iso88591ToUtfProc;
@@ -517,6 +510,10 @@ FillEncodingFileMap(void)
*---------------------------------------------------------------------------
*/
+/* Those flags must not conflict with other TCL_ENCODING_* flags in tcl.h */
+#define TCL_ENCODING_LE 0x40 /* Little-endian encoding */
+#define TCL_ENCODING_EXTERNAL 0x80 /* Converting from internal to external variant */
+
void
TclInitEncodingSubsystem(void)
{
@@ -525,7 +522,7 @@ TclInitEncodingSubsystem(void)
unsigned size;
unsigned short i;
union {
- char c;
+ unsigned char c;
short s;
} isLe;
@@ -533,7 +530,7 @@ TclInitEncodingSubsystem(void)
return;
}
- isLe.s = 1;
+ isLe.s = TCL_ENCODING_LE;
Tcl_MutexLock(&encodingMutex);
Tcl_InitHashTable(&encodingTable, TCL_STRING_KEYS);
Tcl_MutexUnlock(&encodingMutex);
@@ -553,8 +550,8 @@ TclInitEncodingSubsystem(void)
tclIdentityEncoding = Tcl_CreateEncoding(&type);
type.encodingName = "utf-8";
- type.toUtfProc = UtfExtToUtfIntProc;
- type.fromUtfProc = UtfIntToUtfExtProc;
+ type.toUtfProc = UtfToUtfProc;
+ type.fromUtfProc = UtfToUtfProc;
type.freeProc = NULL;
type.nullSize = 1;
type.clientData = NULL;
@@ -565,7 +562,7 @@ TclInitEncodingSubsystem(void)
type.freeProc = NULL;
type.nullSize = 2;
type.encodingName = "ucs-2le";
- type.clientData = INT2PTR(1);
+ type.clientData = INT2PTR(TCL_ENCODING_LE);
Tcl_CreateEncoding(&type);
type.encodingName = "ucs-2be";
type.clientData = INT2PTR(0);
@@ -579,7 +576,7 @@ TclInitEncodingSubsystem(void)
type.freeProc = NULL;
type.nullSize = 2;
type.encodingName = "utf-16le";
- type.clientData = INT2PTR(1);
+ type.clientData = INT2PTR(TCL_ENCODING_LE);
Tcl_CreateEncoding(&type);
type.encodingName = "utf-16be";
type.clientData = INT2PTR(0);
@@ -1269,8 +1266,8 @@ Tcl_UtfToExternalDString(
flags = TCL_ENCODING_START | TCL_ENCODING_END;
while (1) {
result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
- srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
- &dstChars);
+ srcLen, flags | TCL_ENCODING_EXTERNAL, &state, dst, dstLen,
+ &srcRead, &dstWrote, &dstChars);
soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
if (result != TCL_CONVERT_NOSPACE) {
@@ -1371,8 +1368,8 @@ Tcl_UtfToExternal(
dstLen -= encodingPtr->nullSize;
result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
- flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
- dstCharsPtr);
+ flags | TCL_ENCODING_EXTERNAL, statePtr, dst, dstLen, srcReadPtr,
+ dstWrotePtr, dstCharsPtr);
if (encodingPtr->nullSize == 2) {
dst[*dstWrotePtr + 1] = '\0';
}
@@ -2094,104 +2091,6 @@ BinaryProc(
/*
*-------------------------------------------------------------------------
*
- * UtfIntToUtfExtProc --
- *
- * Convert from UTF-8 to UTF-8. While converting null-bytes from the
- * Tcl's internal representation (0xC0, 0x80) to the official
- * representation (0x00). See UtfToUtfProc for details.
- *
- * Results:
- * Returns TCL_OK if conversion was successful.
- *
- * Side effects:
- * None.
- *
- *-------------------------------------------------------------------------
- */
-
-static int
-UtfIntToUtfExtProc(
- ClientData clientData,
- const char *src, /* Source string in UTF-8. */
- int srcLen, /* Source string length in bytes. */
- int flags, /* Conversion control flags. */
- Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
- * information used during a piecewise
- * conversion. Contents of statePtr are
- * initialized and/or reset by conversion
- * routine under control of flags argument. */
- char *dst, /* Output buffer in which converted string
- * is stored. */
- int dstLen, /* The maximum length of output buffer in
- * bytes. */
- int *srcReadPtr, /* Filled with the number of bytes from the
- * source string that were converted. This may
- * be less than the original source length if
- * there was a problem converting some source
- * characters. */
- int *dstWrotePtr, /* Filled with the number of bytes that were
- * stored in the output buffer as a result of
- * the conversion. */
- int *dstCharsPtr) /* Filled with the number of characters that
- * correspond to the bytes stored in the
- * output buffer. */
-{
- return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr, 1);
-}
-
-/*
- *-------------------------------------------------------------------------
- *
- * UtfExtToUtfIntProc --
- *
- * Convert from UTF-8 to UTF-8 while converting null-bytes from the
- * official representation (0x00) to Tcl's internal representation (0xC0,
- * 0x80). See UtfToUtfProc for details.
- *
- * Results:
- * Returns TCL_OK if conversion was successful.
- *
- * Side effects:
- * None.
- *
- *-------------------------------------------------------------------------
- */
-
-static int
-UtfExtToUtfIntProc(
- ClientData clientData,
- const char *src, /* Source string in UTF-8. */
- int srcLen, /* Source string length in bytes. */
- int flags, /* Conversion control flags. */
- Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
- * information used during a piecewise
- * conversion. Contents of statePtr are
- * initialized and/or reset by conversion
- * routine under control of flags argument. */
- char *dst, /* Output buffer in which converted string is
- * stored. */
- int dstLen, /* The maximum length of output buffer in
- * bytes. */
- int *srcReadPtr, /* Filled with the number of bytes from the
- * source string that were converted. This may
- * be less than the original source length if
- * there was a problem converting some source
- * characters. */
- int *dstWrotePtr, /* Filled with the number of bytes that were
- * stored in the output buffer as a result of
- * the conversion. */
- int *dstCharsPtr) /* Filled with the number of characters that
- * correspond to the bytes stored in the
- * output buffer. */
-{
- return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr, 0);
-}
-
-/*
- *-------------------------------------------------------------------------
- *
* UtfToUtfProc --
*
* Convert from UTF-8 to UTF-8. Note that the UTF-8 to UTF-8 translation
@@ -2213,11 +2112,7 @@ UtfToUtfProc(
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
- Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
- * information used during a piecewise
- * conversion. Contents of statePtr are
- * initialized and/or reset by conversion
- * routine under control of flags argument. */
+ TCL_UNUSED(Tcl_EncodingState *),
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
@@ -2230,21 +2125,15 @@ UtfToUtfProc(
int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr, /* Filled with the number of characters that
+ int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
- int pureNullMode) /* Convert embedded nulls from internal
- * representation to real null-bytes or vice
- * versa. Also combine or separate surrogate pairs */
{
const char *srcStart, *srcEnd, *srcClose;
const char *dstStart, *dstEnd;
int result, numChars, charLimit = INT_MAX;
- int *chPtr = (int *) statePtr;
+ int ch;
- if (flags & TCL_ENCODING_START) {
- *statePtr = 0;
- }
result = TCL_OK;
srcStart = src;
@@ -2274,15 +2163,15 @@ UtfToUtfProc(
result = TCL_CONVERT_NOSPACE;
break;
}
- if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && pureNullMode == 0)) {
+ if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && !(flags & TCL_ENCODING_EXTERNAL))) {
/*
* Copy 7bit characters, but skip null-bytes when we are in input
* mode, so that they get converted to 0xC080.
*/
*dst++ = *src++;
- } else if (pureNullMode == 1 && UCHAR(*src) == 0xC0 &&
- (src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) {
+ } else if (UCHAR(*src) == 0xC0 && (src + 1 < srcEnd)
+ && UCHAR(src[1]) == 0x80 && (flags & TCL_ENCODING_EXTERNAL)) {
/*
* Convert 0xC080 to real nulls when we are in output mode.
*/
@@ -2293,29 +2182,43 @@ UtfToUtfProc(
/*
* Always check before using TclUtfToUCS4. Not doing can so
* cause it run beyond the end of the buffer! If we happen such an
- * incomplete char its bytes are made to represent themselves.
+ * incomplete char its bytes are made to represent themselves
+ * unless the user has explicitly asked to be told.
*/
- *chPtr = UCHAR(*src);
+ if (flags & TCL_ENCODING_STOPONERROR) {
+ result = TCL_CONVERT_MULTIBYTE;
+ break;
+ }
+ ch = UCHAR(*src);
src += 1;
- dst += Tcl_UniCharToUtf(*chPtr, dst);
+ dst += Tcl_UniCharToUtf(ch, dst);
} else {
- src += TclUtfToUCS4(src, chPtr);
- if ((*chPtr | 0x7FF) == 0xDFFF) {
- /* A surrogate character is detected, handle especially */
- int low = *chPtr;
- size_t len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;
- if (((low & ~0x3FF) != 0xDC00) || (*chPtr & 0x400)) {
- *dst++ = (char) (((*chPtr >> 12) | 0xE0) & 0xEF);
- *dst++ = (char) (((*chPtr >> 6) | 0x80) & 0xBF);
- *dst++ = (char) ((*chPtr | 0x80) & 0xBF);
- continue;
+ size_t len = TclUtfToUCS4(src, &ch);
+ if ((len < 2) && (ch != 0) && (flags & TCL_ENCODING_STOPONERROR)) {
+ result = TCL_CONVERT_SYNTAX;
+ break;
+ }
+ src += len;
+ if ((ch | 0x7FF) == 0xDFFF) {
+ /*
+ * A surrogate character is detected, handle especially.
+ */
+
+ int low = ch;
+ len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;
+
+ if (((low & ~0x3FF) != 0xDC00) || (ch & 0x400)) {
+ *dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
+ *dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
+ *dst++ = (char) ((ch | 0x80) & 0xBF);
+ continue;
}
src += len;
- dst += Tcl_UniCharToUtf(*chPtr, dst);
- *chPtr = low;
+ dst += Tcl_UniCharToUtf(ch, dst);
+ ch = low;
}
- dst += Tcl_UniCharToUtf(*chPtr, dst);
+ dst += Tcl_UniCharToUtf(ch, dst);
}
}
@@ -2343,7 +2246,7 @@ UtfToUtfProc(
static int
Utf16ToUtfProc(
- ClientData clientData, /* != NULL means LE, == NUL means BE */
+ ClientData clientData, /* additional flags, e.g. TCL_ENCODING_LE */
const char *src, /* Source string in Unicode. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
@@ -2369,18 +2272,27 @@ Utf16ToUtfProc(
int result, numChars, charLimit = INT_MAX;
unsigned short ch;
+ flags |= PTR2INT(clientData);
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
result = TCL_OK;
- /* check alignment with utf-16 (2 == sizeof(UTF-16)) */
+ /*
+ * Check alignment with utf-16 (2 == sizeof(UTF-16))
+ */
+
if ((srcLen % 2) != 0) {
result = TCL_CONVERT_MULTIBYTE;
srcLen--;
}
- /* If last code point is a high surrogate, we cannot handle that yet */
- if ((srcLen >= 2) && ((src[srcLen - (clientData?1:2)] & 0xFC) == 0xD8)) {
+
+ /*
+ * If last code point is a high surrogate, we cannot handle that yet.
+ */
+
+ if ((srcLen >= 2) &&
+ ((src[srcLen - ((flags & TCL_ENCODING_LE)?1:2)] & 0xFC) == 0xD8)) {
result = TCL_CONVERT_MULTIBYTE;
srcLen-= 2;
}
@@ -2397,15 +2309,17 @@ Utf16ToUtfProc(
break;
}
- if (clientData) {
+ if (flags & TCL_ENCODING_LE) {
ch = (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
} else {
ch = (src[0] & 0xFF) << 8 | (src[1] & 0xFF);
}
+
/*
* Special case for 1-byte utf chars for speed. Make sure we work with
* unsigned short-size data.
*/
+
if (ch && ch < 0x80) {
*dst++ = (ch & 0xFF);
} else {
@@ -2442,11 +2356,7 @@ UtfToUtf16Proc(
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
- Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
- * information used during a piecewise
- * conversion. Contents of statePtr are
- * initialized and/or reset by conversion
- * routine under control of flags argument. */
+ TCL_UNUSED(Tcl_EncodingState *),
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
@@ -2465,11 +2375,8 @@ UtfToUtf16Proc(
{
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
int result, numChars;
- Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
+ int ch;
- if (flags & TCL_ENCODING_START) {
- *statePtr = 0;
- }
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
@@ -2495,38 +2402,27 @@ UtfToUtf16Proc(
result = TCL_CONVERT_NOSPACE;
break;
}
- src += TclUtfToUniChar(src, chPtr);
-
+ src += TclUtfToUCS4(src, &ch);
if (clientData) {
-#if TCL_UTF_MAX > 3
- if (*chPtr <= 0xFFFF) {
- *dst++ = (*chPtr & 0xFF);
- *dst++ = (*chPtr >> 8);
+ if (ch <= 0xFFFF) {
+ *dst++ = (ch & 0xFF);
+ *dst++ = (ch >> 8);
} else {
- *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
- *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
- *dst++ = (*chPtr & 0xFF);
- *dst++ = ((*chPtr >> 8) & 0x3) | 0xDC;
+ *dst++ = (((ch - 0x10000) >> 10) & 0xFF);
+ *dst++ = (((ch - 0x10000) >> 18) & 0x3) | 0xD8;
+ *dst++ = (ch & 0xFF);
+ *dst++ = ((ch >> 8) & 0x3) | 0xDC;
}
-#else
- *dst++ = (*chPtr & 0xFF);
- *dst++ = (*chPtr >> 8);
-#endif
} else {
-#if TCL_UTF_MAX > 3
- if (*chPtr <= 0xFFFF) {
- *dst++ = (*chPtr >> 8);
- *dst++ = (*chPtr & 0xFF);
+ if (ch <= 0xFFFF) {
+ *dst++ = (ch >> 8);
+ *dst++ = (ch & 0xFF);
} else {
- *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
- *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
- *dst++ = ((*chPtr >> 8) & 0x3) | 0xDC;
- *dst++ = (*chPtr & 0xFF);
+ *dst++ = (((ch - 0x10000) >> 18) & 0x3) | 0xD8;
+ *dst++ = (((ch - 0x10000) >> 10) & 0xFF);
+ *dst++ = ((ch >> 8) & 0x3) | 0xDC;
+ *dst++ = (ch & 0xFF);
}
-#else
- *dst++ = (*chPtr >> 8);
- *dst++ = (*chPtr & 0xFF);
-#endif
}
}
*srcReadPtr = src - srcStart;
@@ -2553,7 +2449,7 @@ UtfToUtf16Proc(
static int
UtfToUcs2Proc(
- ClientData clientData, /* != NULL means LE, == NUL means BE */
+ ClientData clientData, /* additional flags, e.g. TCL_ENCODING_LE */
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
@@ -2581,6 +2477,7 @@ UtfToUcs2Proc(
#endif
Tcl_UniChar ch = 0;
+ flags |= PTR2INT(clientData);
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
@@ -2624,7 +2521,7 @@ UtfToUcs2Proc(
* casting dst to a Tcl_UniChar. [Bug 1122671]
*/
- if (clientData) {
+ if (flags & TCL_ENCODING_LE) {
*dst++ = (ch & 0xFF);
*dst++ = (ch >> 8);
} else {
@@ -3032,7 +2929,9 @@ Iso88591FromUtfProc(
break;
}
#if TCL_UTF_MAX <= 3
- if ((ch >= 0xD800) && (len < 3)) len = 4;
+ if ((ch >= 0xD800) && (len < 3)) {
+ len = 4;
+ }
#endif
/*
* Plunge on, using '?' as a fallback character.
@@ -3077,7 +2976,7 @@ TableFreeProc(
ClientData clientData) /* TableEncodingData that specifies
* encoding. */
{
- TableEncodingData *dataPtr = (TableEncodingData *)clientData;
+ TableEncodingData *dataPtr = (TableEncodingData *) clientData;
/*
* Make sure we aren't freeing twice on shutdown. [Bug 219314]
@@ -3135,7 +3034,7 @@ EscapeToUtfProc(
* correspond to the bytes stored in the
* output buffer. */
{
- EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
+ EscapeEncodingData *dataPtr = (EscapeEncodingData *) clientData;
const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
const unsigned short *const *tableToUnicode;
const Encoding *encodingPtr;
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 3717896..4d46acf 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1502,7 +1502,7 @@ Tcl_UpdateObjCmd(
}
switch ((enum updateOptionsEnum) optionIndex) {
case OPT_IDLETASKS:
- flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+ flags = TCL_IDLE_EVENTS|TCL_DONT_WAIT;
break;
default:
Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 770533f..93d0a32 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -56,8 +56,7 @@ static void TimerRunRead(ClientData clientData);
static void TimerRunWrite(ClientData clientData);
/*
- * The C layer channel type/driver definition used by the reflection. This is
- * a version 3 structure.
+ * The C layer channel type/driver definition used by the reflection.
*/
static const Tcl_ChannelType tclRChannelType = {
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 3a9e07f..b665589 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -1237,7 +1237,6 @@ PrintUsage(
int width, numSpaces;
#define NUM_SPACES 20
static const char spaces[] = " ";
- char tmp[TCL_DOUBLE_SPACE];
Tcl_Obj *msg;
/*
@@ -1287,7 +1286,6 @@ PrintUsage(
case TCL_ARGV_FLOAT:
Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g",
*((double *) infoPtr->dstPtr));
- sprintf(tmp, "%g", *((double *) infoPtr->dstPtr));
break;
case TCL_ARGV_STRING: {
char *string = *((char **) infoPtr->dstPtr);
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index ba4da9e..f0d430a 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -577,7 +577,7 @@ declare 256 {
Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
}
declare 257 {
- void TclStaticPackage(Tcl_Interp *interp, const char *pkgName,
+ void TclStaticPackage(Tcl_Interp *interp, const char *prefix,
Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index cd3baa7..4bf077b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2974,7 +2974,7 @@ MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr,
size_t *sizePtr);
-MODULE_SCOPE int TclGetLoadedPackagesEx(Tcl_Interp *interp,
+MODULE_SCOPE int TclGetLoadedLibraries(Tcl_Interp *interp,
const char *targetName,
const char *packageName);
MODULE_SCOPE int TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 48eb4b2..e660e40 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -573,7 +573,7 @@ EXTERN int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr,
Tcl_Obj *part2Ptr, const int flags);
/* 257 */
EXTERN void TclStaticPackage(Tcl_Interp *interp,
- const char *pkgName,
+ const char *prefix,
Tcl_PackageInitProc *initProc,
Tcl_PackageInitProc *safeInitProc);
/* 258 */
@@ -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 (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */
+ void (*tclStaticPackage) (Tcl_Interp *interp, const char *prefix, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */
Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
} TclIntStubs;
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 364e97b..8c163b7 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -13,21 +13,21 @@
#include "tclInt.h"
/*
- * The following structure describes a package that has been loaded either
+ * The following structure describes a library that has been loaded either
* dynamically (with the "load" command) or statically (as indicated by a call
- * to TclGetLoadedPackages). All such packages are linked together into a
- * single list for the process. Packages are never unloaded, until the
+ * to Tcl_StaticPackage). 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.
*/
-typedef struct LoadedPackage {
- char *fileName; /* Name of the file from which the package was
- * loaded. An empty string means the package
+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 *packageName; /* Name of package prefix for the package,
+ char *prefix; /* Prefix for the library,
* properly capitalized (first letter UC,
- * others LC), no "_", as in "Net".
+ * others LC), as in "Net".
* Malloc-ed. */
Tcl_LoadHandle loadHandle; /* Token for the loaded file which should be
* passed to (*unLoadProcPtr)() when the file
@@ -35,59 +35,59 @@ typedef struct LoadedPackage {
* then this field is irrelevant. */
Tcl_PackageInitProc *initProc;
/* Initialization function to call to
- * incorporate this package into a trusted
+ * incorporate this library into a trusted
* interpreter. */
Tcl_PackageInitProc *safeInitProc;
/* Initialization function to call to
- * incorporate this package into a safe
+ * incorporate this library into a safe
* interpreter (one that will execute
- * untrusted scripts). NULL means the package
+ * untrusted scripts). NULL means the library
* can't be used in unsafe interpreters. */
Tcl_PackageUnloadProc *unloadProc;
- /* Finalisation function to unload a package
+ /* Finalization function to unload a library
* from a trusted interpreter. NULL means that
- * the package cannot be unloaded. */
+ * the library cannot be unloaded. */
Tcl_PackageUnloadProc *safeUnloadProc;
- /* Finalisation function to unload a package
+ /* Finalization function to unload a library
* from a safe interpreter. NULL means that
- * the package cannot be unloaded. */
- int interpRefCount; /* How many times the package has been loaded
+ * the library cannot be unloaded. */
+ int interpRefCount; /* How many times the library has been loaded
* in trusted interpreters. */
- int safeInterpRefCount; /* How many times the package has been loaded
+ int safeInterpRefCount; /* How many times the library has been loaded
* in safe interpreters. */
- struct LoadedPackage *nextPtr;
- /* Next in list of all packages loaded into
+ struct LoadedLibrary *nextPtr;
+ /* Next in list of all libraries loaded into
* this application process. NULL means end of
* list. */
-} LoadedPackage;
+} LoadedLibrary;
/*
* TCL_THREADS
- * There is a global list of packages that is anchored at firstPackagePtr.
+ * There is a global list of libraries that is anchored at firstLibraryPtr.
* Access to this list is governed by a mutex.
*/
-static LoadedPackage *firstPackagePtr = NULL;
- /* First in list of all packages loaded into
+static LoadedLibrary *firstLibraryPtr = NULL;
+ /* First in list of all libraries loaded into
* this process. */
-TCL_DECLARE_MUTEX(packageMutex)
+TCL_DECLARE_MUTEX(libraryMutex)
/*
- * The following structure represents a particular package that has been
+ * The following structure represents a particular library that has been
* incorporated into a particular interpreter (by calling its initialization
* function). There is a list of these structures for each interpreter, with
* an AssocData value (key "load") for the interpreter that points to the
- * first package (if any).
+ * first library (if any).
*/
-typedef struct InterpPackage {
- LoadedPackage *pkgPtr; /* Points to detailed information about
- * package. */
- struct InterpPackage *nextPtr;
- /* Next package in this interpreter, or NULL
+typedef struct InterpLibrary {
+ LoadedLibrary *libraryPtr; /* Points to detailed information about
+ * library. */
+ struct InterpLibrary *nextPtr;
+ /* Next library in this interpreter, or NULL
* for end of list. */
-} InterpPackage;
+} InterpLibrary;
/*
* Prototypes for functions that are private to this file:
@@ -121,14 +121,14 @@ Tcl_LoadObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target;
- LoadedPackage *pkgPtr, *defaultPtr;
- Tcl_DString pkgName, tmp, initName, safeInitName;
+ LoadedLibrary *libraryPtr, *defaultPtr;
+ Tcl_DString pfx, tmp, initName, safeInitName;
Tcl_DString unloadName, safeUnloadName;
- InterpPackage *ipFirstPtr, *ipPtr;
+ InterpLibrary *ipFirstPtr, *ipPtr;
int code, namesMatch, filesMatch, offset;
const char *symbols[2];
Tcl_PackageInitProc *initProc;
- const char *p, *fullFileName, *packageName;
+ const char *p, *fullFileName, *prefix;
Tcl_LoadHandle loadHandle;
Tcl_UniChar ch = 0;
size_t len;
@@ -159,7 +159,7 @@ Tcl_LoadObjCmd(
}
}
if ((objc < 2) || (objc > 4)) {
- Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?packageName? ?interp?");
+ Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?prefix? ?interp?");
return TCL_ERROR;
}
if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
@@ -167,23 +167,23 @@ Tcl_LoadObjCmd(
}
fullFileName = TclGetString(objv[1]);
- Tcl_DStringInit(&pkgName);
+ Tcl_DStringInit(&pfx);
Tcl_DStringInit(&initName);
Tcl_DStringInit(&safeInitName);
Tcl_DStringInit(&unloadName);
Tcl_DStringInit(&safeUnloadName);
Tcl_DStringInit(&tmp);
- packageName = NULL;
+ prefix = NULL;
if (objc >= 3) {
- packageName = TclGetString(objv[2]);
- if (packageName[0] == '\0') {
- packageName = NULL;
+ prefix = TclGetString(objv[2]);
+ if (prefix[0] == '\0') {
+ prefix = NULL;
}
}
- if ((fullFileName[0] == 0) && (packageName == NULL)) {
+ if ((fullFileName[0] == 0) && (prefix == NULL)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "must specify either file name or package name", -1));
+ "must specify either file name or prefix", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY",
NULL);
code = TCL_ERROR;
@@ -191,7 +191,7 @@ Tcl_LoadObjCmd(
}
/*
- * Figure out which interpreter we're going to load the package into.
+ * Figure out which interpreter we're going to load the library into.
*/
target = interp;
@@ -206,89 +206,89 @@ Tcl_LoadObjCmd(
}
/*
- * Scan through the packages that are currently loaded to see if the
- * package we want is already loaded. We'll use a loaded package if it
+ * Scan through the libraries that are currently loaded to see if the
+ * library we want is already loaded. We'll use a loaded library if it
* meets any of the following conditions:
* - Its name and file match the once we're looking for.
* - Its file matches, and we weren't given a name.
* - Its name matches, the file name was specified as empty, and there is
- * only no statically loaded package with the same name.
+ * only no statically loaded library with the same prefix.
*/
- Tcl_MutexLock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
defaultPtr = NULL;
- for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
- if (packageName == NULL) {
+ for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) {
+ if (prefix == NULL) {
namesMatch = 0;
} else {
- TclDStringClear(&pkgName);
- Tcl_DStringAppend(&pkgName, packageName, -1);
+ TclDStringClear(&pfx);
+ Tcl_DStringAppend(&pfx, prefix, -1);
TclDStringClear(&tmp);
- Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
- Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
+ Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1);
+ Tcl_UtfToLower(Tcl_DStringValue(&pfx));
Tcl_UtfToLower(Tcl_DStringValue(&tmp));
if (strcmp(Tcl_DStringValue(&tmp),
- Tcl_DStringValue(&pkgName)) == 0) {
+ Tcl_DStringValue(&pfx)) == 0) {
namesMatch = 1;
} else {
namesMatch = 0;
}
}
- TclDStringClear(&pkgName);
+ TclDStringClear(&pfx);
- filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
- if (filesMatch && (namesMatch || (packageName == NULL))) {
+ filesMatch = (strcmp(libraryPtr->fileName, fullFileName) == 0);
+ if (filesMatch && (namesMatch || (prefix == NULL))) {
break;
}
if (namesMatch && (fullFileName[0] == 0)) {
- defaultPtr = pkgPtr;
+ defaultPtr = libraryPtr;
}
if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
/*
- * Can't have two different packages loaded from the same file.
+ * Can't have two different libraries loaded from the same file.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "file \"%s\" is already loaded for package \"%s\"",
- fullFileName, pkgPtr->packageName));
+ "file \"%s\" is already loaded for prefix \"%s\"",
+ fullFileName, libraryPtr->prefix));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
"SPLITPERSONALITY", NULL);
code = TCL_ERROR;
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
goto done;
}
}
- Tcl_MutexUnlock(&packageMutex);
- if (pkgPtr == NULL) {
- pkgPtr = defaultPtr;
+ Tcl_MutexUnlock(&libraryMutex);
+ if (libraryPtr == NULL) {
+ libraryPtr = defaultPtr;
}
/*
- * Scan through the list of packages already loaded in the target
- * interpreter. If the package we want is already loaded there, then
+ * Scan through the list of libraries already loaded in the target
+ * interpreter. If the library we want is already loaded there, then
* there's nothing for us to do.
*/
- if (pkgPtr != NULL) {
- ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
+ if (libraryPtr != NULL) {
+ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
- if (ipPtr->pkgPtr == pkgPtr) {
+ if (ipPtr->libraryPtr == libraryPtr) {
code = TCL_OK;
goto done;
}
}
}
- if (pkgPtr == NULL) {
+ if (libraryPtr == NULL) {
/*
* The desired file isn't currently loaded, so load it. It's an error
- * if the desired package is a static one.
+ * if the desired library is a static one.
*/
if (fullFileName[0] == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "package \"%s\" isn't loaded statically", packageName));
+ "no library with prefix \"%s\" is loaded statically", prefix));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC",
NULL);
code = TCL_ERROR;
@@ -296,11 +296,11 @@ Tcl_LoadObjCmd(
}
/*
- * Figure out the module name if it wasn't provided explicitly.
+ * Figure out the prefix if it wasn't provided explicitly.
*/
- if (packageName != NULL) {
- Tcl_DStringAppend(&pkgName, packageName, -1);
+ if (prefix != NULL) {
+ Tcl_DStringAppend(&pfx, prefix, -1);
} else {
Tcl_Obj *splitPtr, *pkgGuessPtr;
int pElements;
@@ -311,11 +311,11 @@ Tcl_LoadObjCmd(
*/
/*
- * The platform-specific code couldn't figure out the module
- * name. Make a guess by taking the last element of the file
- * name, stripping off any leading "lib", and then using all
- * of the alphabetic and underline characters that follow
- * that.
+ * 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
+ * then using all of the alphabetic and underline characters
+ * that follow that.
*/
splitPtr = Tcl_FSSplitPath(objv[1], &pElements);
@@ -346,85 +346,85 @@ Tcl_LoadObjCmd(
if (p == pkgGuess) {
Tcl_DecrRefCount(splitPtr);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't figure out package name for %s",
+ "couldn't figure out prefix for %s",
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
- "WHATPACKAGE", NULL);
+ "WHATLIBRARY", NULL);
code = TCL_ERROR;
goto done;
}
- Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess);
+ Tcl_DStringAppend(&pfx, pkgGuess, p - pkgGuess);
Tcl_DecrRefCount(splitPtr);
}
/*
- * Fix the capitalization in the package name so that the first
+ * 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(&pkgName,
- Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));
+ Tcl_DStringSetLength(&pfx,
+ Tcl_UtfToTitle(Tcl_DStringValue(&pfx)));
/*
* Compute the names of the two initialization functions, based on the
- * package name.
+ * prefix.
*/
- TclDStringAppendDString(&initName, &pkgName);
+ TclDStringAppendDString(&initName, &pfx);
TclDStringAppendLiteral(&initName, "_Init");
- TclDStringAppendDString(&safeInitName, &pkgName);
+ TclDStringAppendDString(&safeInitName, &pfx);
TclDStringAppendLiteral(&safeInitName, "_SafeInit");
- TclDStringAppendDString(&unloadName, &pkgName);
+ TclDStringAppendDString(&unloadName, &pfx);
TclDStringAppendLiteral(&unloadName, "_Unload");
- TclDStringAppendDString(&safeUnloadName, &pkgName);
+ TclDStringAppendDString(&safeUnloadName, &pfx);
TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload");
/*
- * Call platform-specific code to load the package and find the two
+ * Call platform-specific code to load the library and find the two
* initialization functions.
*/
symbols[0] = Tcl_DStringValue(&initName);
symbols[1] = NULL;
- Tcl_MutexLock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
code = Tcl_LoadFile(interp, objv[1], symbols, flags, &initProc,
&loadHandle);
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
if (code != TCL_OK) {
goto done;
}
/*
- * Create a new record to describe this package.
+ * Create a new record to describe this library.
*/
- pkgPtr = (LoadedPackage *)Tcl_Alloc(sizeof(LoadedPackage));
+ libraryPtr = (LoadedLibrary *)Tcl_Alloc(sizeof(LoadedLibrary));
len = strlen(fullFileName) + 1;
- pkgPtr->fileName = (char *)Tcl_Alloc(len);
- memcpy(pkgPtr->fileName, fullFileName, len);
- len = Tcl_DStringLength(&pkgName) + 1;
- pkgPtr->packageName = (char *)Tcl_Alloc(len);
- memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
- pkgPtr->loadHandle = loadHandle;
- pkgPtr->initProc = initProc;
- pkgPtr->safeInitProc = (Tcl_PackageInitProc *)
+ libraryPtr->fileName = (char *)Tcl_Alloc(len);
+ memcpy(libraryPtr->fileName, fullFileName, len);
+ len = Tcl_DStringLength(&pfx) + 1;
+ libraryPtr->prefix = (char *)Tcl_Alloc(len);
+ memcpy(libraryPtr->prefix, Tcl_DStringValue(&pfx), len);
+ libraryPtr->loadHandle = loadHandle;
+ libraryPtr->initProc = initProc;
+ libraryPtr->safeInitProc = (Tcl_PackageInitProc *)
Tcl_FindSymbol(interp, loadHandle,
Tcl_DStringValue(&safeInitName));
- pkgPtr->unloadProc = (Tcl_PackageUnloadProc *)
+ libraryPtr->unloadProc = (Tcl_PackageUnloadProc *)
Tcl_FindSymbol(interp, loadHandle,
Tcl_DStringValue(&unloadName));
- pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc *)
+ libraryPtr->safeUnloadProc = (Tcl_PackageUnloadProc *)
Tcl_FindSymbol(interp, loadHandle,
Tcl_DStringValue(&safeUnloadName));
- pkgPtr->interpRefCount = 0;
- pkgPtr->safeInterpRefCount = 0;
+ libraryPtr->interpRefCount = 0;
+ libraryPtr->safeInterpRefCount = 0;
- Tcl_MutexLock(&packageMutex);
- pkgPtr->nextPtr = firstPackagePtr;
- firstPackagePtr = pkgPtr;
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
+ libraryPtr->nextPtr = firstLibraryPtr;
+ firstLibraryPtr = libraryPtr;
+ Tcl_MutexUnlock(&libraryMutex);
/*
* The Tcl_FindSymbol calls may have left a spurious error message in
@@ -435,32 +435,32 @@ Tcl_LoadObjCmd(
}
/*
- * Invoke the package's initialization function (either the normal one or
+ * Invoke the library's initialization function (either the normal one or
* the safe one, depending on whether or not the interpreter is safe).
*/
if (Tcl_IsSafe(target)) {
- if (pkgPtr->safeInitProc == NULL) {
+ if (libraryPtr->safeInitProc == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't use package in a safe interpreter: no"
- " %s_SafeInit procedure", pkgPtr->packageName));
+ "can't use library in a safe interpreter: no"
+ " %s_SafeInit procedure", libraryPtr->prefix));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE",
NULL);
code = TCL_ERROR;
goto done;
}
- code = pkgPtr->safeInitProc(target);
+ code = libraryPtr->safeInitProc(target);
} else {
- if (pkgPtr->initProc == NULL) {
+ if (libraryPtr->initProc == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't attach package to interpreter: no %s_Init procedure",
- pkgPtr->packageName));
+ "can't attach library to interpreter: no %s_Init procedure",
+ libraryPtr->prefix));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
NULL);
code = TCL_ERROR;
goto done;
}
- code = pkgPtr->initProc(target);
+ code = libraryPtr->initProc(target);
}
/*
@@ -485,33 +485,33 @@ Tcl_LoadObjCmd(
}
/*
- * Record the fact that the package has been loaded in the target
+ * Record the fact that the library has been loaded in the target
* interpreter.
*
* Update the proper reference count.
*/
- Tcl_MutexLock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
if (Tcl_IsSafe(target)) {
- pkgPtr->safeInterpRefCount++;
+ libraryPtr->safeInterpRefCount++;
} else {
- pkgPtr->interpRefCount++;
+ libraryPtr->interpRefCount++;
}
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
/*
- * Refetch ipFirstPtr: loading the package may have introduced additional
- * static packages at the head of the linked list!
+ * Refetch ipFirstPtr: loading the library may have introduced additional
+ * static libraries at the head of the linked list!
*/
- ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
- ipPtr = (InterpPackage *)Tcl_Alloc(sizeof(InterpPackage));
- ipPtr->pkgPtr = pkgPtr;
+ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
+ ipPtr = (InterpLibrary *)Tcl_Alloc(sizeof(InterpLibrary));
+ ipPtr->libraryPtr = libraryPtr;
ipPtr->nextPtr = ipFirstPtr;
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);
done:
- Tcl_DStringFree(&pkgName);
+ Tcl_DStringFree(&pfx);
Tcl_DStringFree(&initName);
Tcl_DStringFree(&safeInitName);
Tcl_DStringFree(&unloadName);
@@ -545,14 +545,14 @@ Tcl_UnloadObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target; /* Which interpreter to unload from. */
- LoadedPackage *pkgPtr, *defaultPtr;
- Tcl_DString pkgName, tmp;
+ LoadedLibrary *libraryPtr, *defaultPtr;
+ Tcl_DString pfx, tmp;
Tcl_PackageUnloadProc *unloadProc;
- InterpPackage *ipFirstPtr, *ipPtr;
+ InterpLibrary *ipFirstPtr, *ipPtr;
int i, index, code, complain = 1, keepLibrary = 0;
int trustedRefCount = -1, safeRefCount = -1;
const char *fullFileName = "";
- const char *packageName;
+ const char *prefix;
static const char *const options[] = {
"-nocomplain", "-keeplibrary", "--", NULL
};
@@ -596,7 +596,7 @@ Tcl_UnloadObjCmd(
endOfForLoop:
if ((objc-i < 1) || (objc-i > 3)) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?-switch ...? fileName ?packageName? ?interp?");
+ "?-switch ...? fileName ?prefix? ?interp?");
return TCL_ERROR;
}
if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
@@ -604,19 +604,19 @@ Tcl_UnloadObjCmd(
}
fullFileName = TclGetString(objv[i]);
- Tcl_DStringInit(&pkgName);
+ Tcl_DStringInit(&pfx);
Tcl_DStringInit(&tmp);
- packageName = NULL;
+ prefix = NULL;
if (objc - i >= 2) {
- packageName = TclGetString(objv[i+1]);
- if (packageName[0] == '\0') {
- packageName = NULL;
+ prefix = TclGetString(objv[i+1]);
+ if (prefix[0] == '\0') {
+ prefix = NULL;
}
}
- if ((fullFileName[0] == 0) && (packageName == NULL)) {
+ if ((fullFileName[0] == 0) && (prefix == NULL)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "must specify either file name or package name", -1));
+ "must specify either file name or prefix", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY",
NULL);
code = TCL_ERROR;
@@ -624,7 +624,7 @@ Tcl_UnloadObjCmd(
}
/*
- * Figure out which interpreter we're going to load the package into.
+ * Figure out which interpreter we're going to load the library into.
*/
target = interp;
@@ -638,65 +638,65 @@ Tcl_UnloadObjCmd(
}
/*
- * Scan through the packages that are currently loaded to see if the
- * package we want is already loaded. We'll use a loaded package if it
+ * Scan through the libraries that are currently loaded to see if the
+ * library we want is already loaded. We'll use a loaded library if it
* meets any of the following conditions:
- * - Its name and file match the once we're looking for.
- * - Its file matches, and we weren't given a name.
- * - Its name matches, the file name was specified as empty, and there is
- * only no statically loaded package with the same name.
+ * - Its prefix and file match the once we're looking for.
+ * - Its file matches, and we weren't given a prefix.
+ * - Its prefix matches, the file name was specified as empty, and there is
+ * only no statically loaded library with the same prefix.
*/
- Tcl_MutexLock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
defaultPtr = NULL;
- for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
+ for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) {
int namesMatch, filesMatch;
- if (packageName == NULL) {
+ if (prefix == NULL) {
namesMatch = 0;
} else {
- TclDStringClear(&pkgName);
- Tcl_DStringAppend(&pkgName, packageName, -1);
+ TclDStringClear(&pfx);
+ Tcl_DStringAppend(&pfx, prefix, -1);
TclDStringClear(&tmp);
- Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
- Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
+ Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1);
+ Tcl_UtfToLower(Tcl_DStringValue(&pfx));
Tcl_UtfToLower(Tcl_DStringValue(&tmp));
if (strcmp(Tcl_DStringValue(&tmp),
- Tcl_DStringValue(&pkgName)) == 0) {
+ Tcl_DStringValue(&pfx)) == 0) {
namesMatch = 1;
} else {
namesMatch = 0;
}
}
- TclDStringClear(&pkgName);
+ TclDStringClear(&pfx);
- filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
- if (filesMatch && (namesMatch || (packageName == NULL))) {
+ filesMatch = (strcmp(libraryPtr->fileName, fullFileName) == 0);
+ if (filesMatch && (namesMatch || (prefix == NULL))) {
break;
}
if (namesMatch && (fullFileName[0] == 0)) {
- defaultPtr = pkgPtr;
+ defaultPtr = libraryPtr;
}
if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
break;
}
}
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
if (fullFileName[0] == 0) {
/*
- * It's an error to try unload a static package.
+ * It's an error to try unload a static library.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "package \"%s\" is loaded statically and cannot be unloaded",
- packageName));
+ "library with prefix \"%s\" is loaded statically and cannot be unloaded",
+ prefix));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC",
NULL);
code = TCL_ERROR;
goto done;
}
- if (pkgPtr == NULL) {
+ if (libraryPtr == NULL) {
/*
* The DLL pointed by the provided filename has never been loaded.
*/
@@ -710,16 +710,16 @@ Tcl_UnloadObjCmd(
}
/*
- * Scan through the list of packages already loaded in the target
- * interpreter. If the package we want is already loaded there, then we
+ * Scan through the list of libraries already loaded in the target
+ * interpreter. If the library we want is already loaded there, then we
* should proceed with unloading.
*/
code = TCL_ERROR;
- if (pkgPtr != NULL) {
- ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
+ if (libraryPtr != NULL) {
+ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
- if (ipPtr->pkgPtr == pkgPtr) {
+ if (ipPtr->libraryPtr == libraryPtr) {
code = TCL_OK;
break;
}
@@ -727,7 +727,7 @@ Tcl_UnloadObjCmd(
}
if (code != TCL_OK) {
/*
- * The package has not been loaded in this interpreter.
+ * The library has not been loaded in this interpreter.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -741,12 +741,12 @@ Tcl_UnloadObjCmd(
/*
* Ensure that the DLL can be unloaded. If it is a trusted interpreter,
- * pkgPtr->unloadProc must not be NULL for the DLL to be unloadable. If
- * the interpreter is a safe one, pkgPtr->safeUnloadProc must be non-NULL.
+ * libraryPtr->unloadProc must not be NULL for the DLL to be unloadable. If
+ * the interpreter is a safe one, libraryPtr->safeUnloadProc must be non-NULL.
*/
if (Tcl_IsSafe(target)) {
- if (pkgPtr->safeUnloadProc == NULL) {
+ if (libraryPtr->safeUnloadProc == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"file \"%s\" cannot be unloaded under a safe interpreter",
fullFileName));
@@ -755,9 +755,9 @@ Tcl_UnloadObjCmd(
code = TCL_ERROR;
goto done;
}
- unloadProc = pkgPtr->safeUnloadProc;
+ unloadProc = libraryPtr->safeUnloadProc;
} else {
- if (pkgPtr->unloadProc == NULL) {
+ if (libraryPtr->unloadProc == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"file \"%s\" cannot be unloaded under a trusted interpreter",
fullFileName));
@@ -766,11 +766,11 @@ Tcl_UnloadObjCmd(
code = TCL_ERROR;
goto done;
}
- unloadProc = pkgPtr->unloadProc;
+ unloadProc = libraryPtr->unloadProc;
}
/*
- * We are ready to unload the package. First, evaluate the unload
+ * We are ready to unload the library. First, evaluate the unload
* function. If this fails, we cannot proceed with unload. Also, we must
* specify the proper flag to pass to the unload callback.
* TCL_UNLOAD_DETACH_FROM_INTERPRETER is defined when the callback should
@@ -781,10 +781,10 @@ Tcl_UnloadObjCmd(
code = TCL_UNLOAD_DETACH_FROM_INTERPRETER;
if (!keepLibrary) {
- Tcl_MutexLock(&packageMutex);
- trustedRefCount = pkgPtr->interpRefCount;
- safeRefCount = pkgPtr->safeInterpRefCount;
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
+ trustedRefCount = libraryPtr->interpRefCount;
+ safeRefCount = libraryPtr->safeInterpRefCount;
+ Tcl_MutexUnlock(&libraryMutex);
if (Tcl_IsSafe(target)) {
safeRefCount--;
@@ -807,34 +807,34 @@ Tcl_UnloadObjCmd(
* if we unload the DLL.
*/
- Tcl_MutexLock(&packageMutex);
+ Tcl_MutexLock(&libraryMutex);
if (Tcl_IsSafe(target)) {
- pkgPtr->safeInterpRefCount--;
+ libraryPtr->safeInterpRefCount--;
/*
* Do not let counter get negative.
*/
- if (pkgPtr->safeInterpRefCount < 0) {
- pkgPtr->safeInterpRefCount = 0;
+ if (libraryPtr->safeInterpRefCount < 0) {
+ libraryPtr->safeInterpRefCount = 0;
}
} else {
- pkgPtr->interpRefCount--;
+ libraryPtr->interpRefCount--;
/*
* Do not let counter get negative.
*/
- if (pkgPtr->interpRefCount < 0) {
- pkgPtr->interpRefCount = 0;
+ if (libraryPtr->interpRefCount < 0) {
+ libraryPtr->interpRefCount = 0;
}
}
- trustedRefCount = pkgPtr->interpRefCount;
- safeRefCount = pkgPtr->safeInterpRefCount;
- Tcl_MutexUnlock(&packageMutex);
+ trustedRefCount = libraryPtr->interpRefCount;
+ safeRefCount = libraryPtr->safeInterpRefCount;
+ Tcl_MutexUnlock(&libraryMutex);
code = TCL_OK;
- if (pkgPtr->safeInterpRefCount <= 0 && pkgPtr->interpRefCount <= 0
+ if (libraryPtr->safeInterpRefCount <= 0 && libraryPtr->interpRefCount <= 0
&& !keepLibrary) {
/*
* Unload the shared library from the application memory...
@@ -848,21 +848,21 @@ Tcl_UnloadObjCmd(
* it's been unloaded.
*/
- if (pkgPtr->fileName[0] != '\0') {
- Tcl_MutexLock(&packageMutex);
- if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) {
+ if (libraryPtr->fileName[0] != '\0') {
+ Tcl_MutexLock(&libraryMutex);
+ if (Tcl_FSUnloadFile(interp, libraryPtr->loadHandle) == TCL_OK) {
/*
* Remove this library from the loaded library cache.
*/
- defaultPtr = pkgPtr;
- if (defaultPtr == firstPackagePtr) {
- firstPackagePtr = pkgPtr->nextPtr;
+ defaultPtr = libraryPtr;
+ if (defaultPtr == firstLibraryPtr) {
+ firstLibraryPtr = libraryPtr->nextPtr;
} else {
- for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
- pkgPtr = pkgPtr->nextPtr) {
- if (pkgPtr->nextPtr == defaultPtr) {
- pkgPtr->nextPtr = defaultPtr->nextPtr;
+ for (libraryPtr = firstLibraryPtr; libraryPtr != NULL;
+ libraryPtr = libraryPtr->nextPtr) {
+ if (libraryPtr->nextPtr == defaultPtr) {
+ libraryPtr->nextPtr = defaultPtr->nextPtr;
break;
}
}
@@ -872,16 +872,16 @@ Tcl_UnloadObjCmd(
* Remove this library from the interpreter's library cache.
*/
- ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
+ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
ipPtr = ipFirstPtr;
- if (ipPtr->pkgPtr == defaultPtr) {
+ if (ipPtr->libraryPtr == defaultPtr) {
ipFirstPtr = ipFirstPtr->nextPtr;
} else {
- InterpPackage *ipPrevPtr;
+ InterpLibrary *ipPrevPtr;
for (ipPrevPtr = ipPtr; ipPtr != NULL;
ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) {
- if (ipPtr->pkgPtr == defaultPtr) {
+ if (ipPtr->libraryPtr == defaultPtr) {
ipPrevPtr->nextPtr = ipPtr->nextPtr;
break;
}
@@ -890,10 +890,10 @@ Tcl_UnloadObjCmd(
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
ipFirstPtr);
Tcl_Free(defaultPtr->fileName);
- Tcl_Free(defaultPtr->packageName);
+ Tcl_Free(defaultPtr->prefix);
Tcl_Free(defaultPtr);
Tcl_Free(ipPtr);
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
} else {
code = TCL_ERROR;
}
@@ -909,7 +909,7 @@ Tcl_UnloadObjCmd(
}
done:
- Tcl_DStringFree(&pkgName);
+ Tcl_DStringFree(&pfx);
Tcl_DStringFree(&tmp);
if (!complain && (code != TCL_OK)) {
code = TCL_OK;
@@ -923,14 +923,14 @@ Tcl_UnloadObjCmd(
*
* Tcl_StaticPackage --
*
- * This function is invoked to indicate that a particular package has
+ * This function is invoked to indicate that a particular library has
* been linked statically with an application.
*
* Results:
* None.
*
* Side effects:
- * Once this function completes, the package becomes loadable via the
+ * Once this function completes, the library becomes loadable via the
* "load" command with an empty file name.
*
*----------------------------------------------------------------------
@@ -938,82 +938,82 @@ Tcl_UnloadObjCmd(
void
Tcl_StaticPackage(
- Tcl_Interp *interp, /* If not NULL, it means that the package has
+ Tcl_Interp *interp, /* If not NULL, it means that the library has
* already been loaded into the given
* interpreter by calling the appropriate init
* proc. */
- const char *pkgName, /* Name of package (must be properly
+ const char *prefix, /* Prefix (must be properly
* capitalized: first letter upper case,
* others lower case). */
Tcl_PackageInitProc *initProc,
/* Function to call to incorporate this
- * package into a trusted interpreter. */
+ * library into a trusted interpreter. */
Tcl_PackageInitProc *safeInitProc)
/* Function to call to incorporate this
- * package into a safe interpreter (one that
+ * library into a safe interpreter (one that
* will execute untrusted scripts). NULL means
- * the package can't be used in safe
+ * the library can't be used in safe
* interpreters. */
{
- LoadedPackage *pkgPtr;
- InterpPackage *ipPtr, *ipFirstPtr;
+ LoadedLibrary *libraryPtr;
+ InterpLibrary *ipPtr, *ipFirstPtr;
/*
- * Check to see if someone else has already reported this package as
+ * Check to see if someone else has already reported this library as
* statically loaded in the process.
*/
- Tcl_MutexLock(&packageMutex);
- for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
- if ((pkgPtr->initProc == initProc)
- && (pkgPtr->safeInitProc == safeInitProc)
- && (strcmp(pkgPtr->packageName, pkgName) == 0)) {
+ Tcl_MutexLock(&libraryMutex);
+ for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) {
+ if ((libraryPtr->initProc == initProc)
+ && (libraryPtr->safeInitProc == safeInitProc)
+ && (strcmp(libraryPtr->prefix, prefix) == 0)) {
break;
}
}
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
/*
- * If the package is not yet recorded as being loaded statically, add it
+ * If the library is not yet recorded as being loaded statically, add it
* to the list now.
*/
- if (pkgPtr == NULL) {
- pkgPtr = (LoadedPackage *)Tcl_Alloc(sizeof(LoadedPackage));
- pkgPtr->fileName = (char *)Tcl_Alloc(1);
- pkgPtr->fileName[0] = 0;
- pkgPtr->packageName = (char *)Tcl_Alloc(strlen(pkgName) + 1);
- strcpy(pkgPtr->packageName, pkgName);
- pkgPtr->loadHandle = NULL;
- pkgPtr->initProc = initProc;
- pkgPtr->safeInitProc = safeInitProc;
- Tcl_MutexLock(&packageMutex);
- pkgPtr->nextPtr = firstPackagePtr;
- firstPackagePtr = pkgPtr;
- Tcl_MutexUnlock(&packageMutex);
+ if (libraryPtr == NULL) {
+ libraryPtr = (LoadedLibrary *)Tcl_Alloc(sizeof(LoadedLibrary));
+ libraryPtr->fileName = (char *)Tcl_Alloc(1);
+ libraryPtr->fileName[0] = 0;
+ libraryPtr->prefix = (char *)Tcl_Alloc(strlen(prefix) + 1);
+ strcpy(libraryPtr->prefix, prefix);
+ libraryPtr->loadHandle = NULL;
+ libraryPtr->initProc = initProc;
+ libraryPtr->safeInitProc = safeInitProc;
+ Tcl_MutexLock(&libraryMutex);
+ libraryPtr->nextPtr = firstLibraryPtr;
+ firstLibraryPtr = libraryPtr;
+ Tcl_MutexUnlock(&libraryMutex);
}
if (interp != NULL) {
/*
- * If we're loading the package into an interpreter, determine whether
+ * If we're loading the library into an interpreter, determine whether
* it's already loaded.
*/
- ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(interp, "tclLoad", NULL);
+ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(interp, "tclLoad", NULL);
for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
- if (ipPtr->pkgPtr == pkgPtr) {
+ if (ipPtr->libraryPtr == libraryPtr) {
return;
}
}
/*
- * Package isn't loaded in the current interp yet. Mark it as now being
+ * Library isn't loaded in the current interp yet. Mark it as now being
* loaded.
*/
- ipPtr = (InterpPackage *)Tcl_Alloc(sizeof(InterpPackage));
- ipPtr->pkgPtr = pkgPtr;
+ ipPtr = (InterpLibrary *)Tcl_Alloc(sizeof(InterpLibrary));
+ ipPtr->libraryPtr = libraryPtr;
ipPtr->nextPtr = ipFirstPtr;
Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
}
@@ -1022,7 +1022,7 @@ Tcl_StaticPackage(
/*
*----------------------------------------------------------------------
*
- * TclGetLoadedPackagesEx --
+ * TclGetLoadedLibraries --
*
* This function returns information about all of the files that are
* loaded (either in a particular interpreter, or for all interpreters).
@@ -1032,7 +1032,7 @@ Tcl_StaticPackage(
* list of lists is placed in the interp's result. Each sublist
* corresponds to one loaded file; its first element is the name of the
* file (or an empty string for something that's statically loaded) and
- * the second element is the name of the package in that file.
+ * the second element is the prefix of the library in that file.
*
* Side effects:
* None.
@@ -1041,33 +1041,33 @@ Tcl_StaticPackage(
*/
int
-TclGetLoadedPackagesEx(
+TclGetLoadedLibraries(
Tcl_Interp *interp, /* Interpreter in which to return information
* or error message. */
const char *targetName, /* Name of target interpreter or NULL. If
* NULL, return info about all interps;
* otherwise, just return info about this
* interpreter. */
- const char *packageName) /* Package name or NULL. If NULL, return info
- * for all packages.
+ const char *prefix) /* Prefix or NULL. If NULL, return info
+ * for all prefixes.
*/
{
Tcl_Interp *target;
- LoadedPackage *pkgPtr;
- InterpPackage *ipPtr;
+ LoadedLibrary *libraryPtr;
+ InterpLibrary *ipPtr;
Tcl_Obj *resultObj, *pkgDesc[2];
if (targetName == NULL) {
TclNewObj(resultObj);
- Tcl_MutexLock(&packageMutex);
- for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
- pkgPtr = pkgPtr->nextPtr) {
- pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
- pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
+ Tcl_MutexLock(&libraryMutex);
+ for (libraryPtr = firstLibraryPtr; libraryPtr != NULL;
+ libraryPtr = libraryPtr->nextPtr) {
+ pkgDesc[0] = Tcl_NewStringObj(libraryPtr->fileName, -1);
+ pkgDesc[1] = Tcl_NewStringObj(libraryPtr->prefix, -1);
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewListObj(2, pkgDesc));
}
- Tcl_MutexUnlock(&packageMutex);
+ Tcl_MutexUnlock(&libraryMutex);
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
@@ -1076,19 +1076,19 @@ TclGetLoadedPackagesEx(
if (target == NULL) {
return TCL_ERROR;
}
- ipPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
+ ipPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
/*
- * Return information about all of the available packages.
+ * Return information about all of the available libraries.
*/
- if (packageName) {
+ if (prefix) {
resultObj = NULL;
for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
- pkgPtr = ipPtr->pkgPtr;
+ libraryPtr = ipPtr->libraryPtr;
- if (!strcmp(packageName, pkgPtr->packageName)) {
- resultObj = Tcl_NewStringObj(pkgPtr->fileName, -1);
+ if (!strcmp(prefix, libraryPtr->prefix)) {
+ resultObj = Tcl_NewStringObj(libraryPtr->fileName, -1);
break;
}
}
@@ -1100,15 +1100,15 @@ TclGetLoadedPackagesEx(
}
/*
- * Return information about only the packages that are loaded in a given
+ * Return information about only the libraries that are loaded in a given
* interpreter.
*/
TclNewObj(resultObj);
for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
- pkgPtr = ipPtr->pkgPtr;
- pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
- pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
+ libraryPtr = ipPtr->libraryPtr;
+ pkgDesc[0] = Tcl_NewStringObj(libraryPtr->fileName, -1);
+ pkgDesc[1] = Tcl_NewStringObj(libraryPtr->prefix, -1);
Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc));
}
Tcl_SetObjResult(interp, resultObj);
@@ -1120,7 +1120,7 @@ TclGetLoadedPackagesEx(
*
* LoadCleanupProc --
*
- * This function is called to delete all of the InterpPackage structures
+ * This function is called to delete all of the InterpLibrary structures
* for an interpreter when the interpreter is deleted. It gets invoked
* via the Tcl AssocData mechanism.
*
@@ -1128,20 +1128,20 @@ TclGetLoadedPackagesEx(
* None.
*
* Side effects:
- * Storage for all of the InterpPackage functions for interp get deleted.
+ * Storage for all of the InterpLibrary functions for interp get deleted.
*
*----------------------------------------------------------------------
*/
static void
LoadCleanupProc(
- ClientData clientData, /* Pointer to first InterpPackage structure
+ ClientData clientData, /* Pointer to first InterpLibrary structure
* for interp. */
TCL_UNUSED(Tcl_Interp *))
{
- InterpPackage *ipPtr, *nextPtr;
+ InterpLibrary *ipPtr, *nextPtr;
- ipPtr = (InterpPackage *)clientData;
+ ipPtr = (InterpLibrary *)clientData;
while (ipPtr != NULL) {
nextPtr = ipPtr->nextPtr;
Tcl_Free(ipPtr);
@@ -1155,7 +1155,7 @@ LoadCleanupProc(
* TclFinalizeLoad --
*
* This function is invoked just before the application exits. It frees
- * all of the LoadedPackage structures.
+ * all of the LoadedLibrary structures.
*
* Results:
* None.
@@ -1169,18 +1169,18 @@ LoadCleanupProc(
void
TclFinalizeLoad(void)
{
- LoadedPackage *pkgPtr;
+ LoadedLibrary *libraryPtr;
/*
* No synchronization here because there should just be one thread alive
- * at this point. Logically, packageMutex should be grabbed at this point,
+ * at this point. Logically, libraryMutex should be grabbed at this point,
* but the Mutexes get finalized before the call to this routine. The only
* subsystem left alive at this point is the memory allocator.
*/
- while (firstPackagePtr != NULL) {
- pkgPtr = firstPackagePtr;
- firstPackagePtr = pkgPtr->nextPtr;
+ while (firstLibraryPtr != NULL) {
+ libraryPtr = firstLibraryPtr;
+ firstLibraryPtr = libraryPtr->nextPtr;
#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
/*
@@ -1190,14 +1190,14 @@ TclFinalizeLoad(void)
* it has been unloaded.
*/
- if (pkgPtr->fileName[0] != '\0') {
- Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle);
+ if (libraryPtr->fileName[0] != '\0') {
+ Tcl_FSUnloadFile(NULL, libraryPtr->loadHandle);
}
#endif
- Tcl_Free(pkgPtr->fileName);
- Tcl_Free(pkgPtr->packageName);
- Tcl_Free(pkgPtr);
+ Tcl_Free(libraryPtr->fileName);
+ Tcl_Free(libraryPtr->prefix);
+ Tcl_Free(libraryPtr);
}
}
diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c
index 672d3c9..d84472c 100644
--- a/generic/tclPkgConfig.c
+++ b/generic/tclPkgConfig.c
@@ -2,7 +2,7 @@
* tclPkgConfig.c --
*
* This file contains the configuration information to embed into the tcl
- * binary library.
+ * library.
*
* Copyright © 2002 Andreas Kupries <andreas_kupries@users.sourceforge.net>
*
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 0ff643b..83f982a 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -4243,7 +4243,7 @@ TeststaticpkgCmd(
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
- argv[0], " pkgName safe loaded\"", NULL);
+ argv[0], " prefix safe loaded\"", NULL);
return TCL_ERROR;
}
if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) {
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index f343196..1eb6315 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -538,7 +538,7 @@ TclThreadAllocObj(void)
cachePtr->numObjects = numMove = NOBJALLOC;
newObjsPtr = (Tcl_Obj *)TclpSysAlloc(sizeof(Tcl_Obj) * numMove);
if (newObjsPtr == NULL) {
- Tcl_Panic("alloc: could not allocate %ld new objects", numMove);
+ Tcl_Panic("alloc: could not allocate %" TCL_Z_MODIFIER "u new objects", numMove);
}
cachePtr->lastPtr = newObjsPtr + numMove - 1;
objPtr = cachePtr->firstObjPtr; /* NULL */
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index c36cf42..dbe6171 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -47,6 +47,7 @@
#define ZIPFS_VOLUME_LEN 9
#define ZIPFS_APP_MOUNT "//zipfs:/app"
#define ZIPFS_ZIP_MOUNT "//zipfs:/lib/tcl"
+#define ZIPFS_FALLBACK_ENCODING "cp437"
/*
* Various constants and offsets found in ZIP archive files
@@ -262,11 +263,19 @@ static struct {
int wrmax; /* Maximum write size of a file; only written
* to from Tcl code in a trusted interpreter,
* so NOT protected by mutex. */
+ char *fallbackEntryEncoding;/* The fallback encoding for ZIP entries when
+ * they are believed to not be UTF-8; only
+ * written to from Tcl code in a trusted
+ * interpreter, so not protected by mutex. */
+ Tcl_Encoding utf8; /* The UTF-8 encoding that we prefer to use
+ * for the strings (especially filenames)
+ * embedded in a ZIP. Other encodings are used
+ * dynamically. */
int idCount; /* Counter for channel names */
Tcl_HashTable fileHash; /* File name to ZipEntry mapping */
Tcl_HashTable zipHash; /* Mount to ZipFile mapping */
} ZipFS = {
- 0, 0, 0, DEFAULT_WRITE_MAX_SIZE, 0,
+ 0, 0, 0, DEFAULT_WRITE_MAX_SIZE, NULL, NULL, 0,
{0,{0,0,0,0},0,0,0,0,0,0,0,0,0},
{0,{0,0,0,0},0,0,0,0,0,0,0,0,0}
};
@@ -686,6 +695,115 @@ CountSlashes(
/*
*-------------------------------------------------------------------------
*
+ * DecodeZipEntryText --
+ *
+ * Given a sequence of bytes from an entry in a ZIP central directory,
+ * convert that into a Tcl string. This is complicated because we don't
+ * actually know what encoding is in use! So we try to use UTF-8, and if
+ * that goes wrong, we fall back to a user-specified encoding, or to an
+ * encoding we specify (Windows code page 437), or to ISO 8859-1 if
+ * absolutely nothing else works.
+ *
+ * During Tcl startup, we skip the user-specified encoding and cp437, as
+ * we may well not have any loadable encodings yet. Tcl's own library
+ * files ought to be using ASCII filenames.
+ *
+ * Results:
+ * The decoded filename; the filename is owned by the argument DString.
+ *
+ * Side effects:
+ * Updates dstPtr.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static char *
+DecodeZipEntryText(
+ const unsigned char *inputBytes,
+ unsigned int inputLength,
+ Tcl_DString *dstPtr)
+{
+ Tcl_Encoding encoding;
+ const char *src;
+ char *dst;
+ int dstLen, srcLen = inputLength, flags;
+ Tcl_EncodingState state;
+
+ Tcl_DStringInit(dstPtr);
+ if (inputLength < 1) {
+ return Tcl_DStringValue(dstPtr);
+ }
+
+ /*
+ * We can't use Tcl_ExternalToUtfDString at this point; it has no way to
+ * fail. So we use this modified version of it that can report encoding
+ * errors to us (so we can fall back to something else).
+ *
+ * The utf-8 encoding is implemented internally, and so is guaranteed to
+ * be present.
+ */
+
+ src = (const char *) inputBytes;
+ dst = Tcl_DStringValue(dstPtr);
+ dstLen = dstPtr->spaceAvl - 1;
+ flags = TCL_ENCODING_START | TCL_ENCODING_END |
+ TCL_ENCODING_STOPONERROR; /* Special flag! */
+
+ while (1) {
+ int srcRead, dstWrote;
+ int result = Tcl_ExternalToUtf(NULL, ZipFS.utf8, src, srcLen, flags,
+ &state, dst, dstLen, &srcRead, &dstWrote, NULL);
+ int soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
+
+ if (result == TCL_OK) {
+ Tcl_DStringSetLength(dstPtr, soFar);
+ return Tcl_DStringValue(dstPtr);
+ } else if (result != TCL_CONVERT_NOSPACE) {
+ break;
+ }
+
+ flags &= ~TCL_ENCODING_START;
+ src += srcRead;
+ srcLen -= srcRead;
+ if (Tcl_DStringLength(dstPtr) == 0) {
+ Tcl_DStringSetLength(dstPtr, dstLen);
+ }
+ Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
+ dst = Tcl_DStringValue(dstPtr) + soFar;
+ dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
+ }
+
+ /*
+ * Something went wrong. Fall back to another encoding. Those *can* use
+ * Tcl_ExternalToUtfDString().
+ */
+
+ encoding = NULL;
+ if (ZipFS.fallbackEntryEncoding) {
+ encoding = Tcl_GetEncoding(NULL, ZipFS.fallbackEntryEncoding);
+ }
+ if (!encoding) {
+ encoding = Tcl_GetEncoding(NULL, ZIPFS_FALLBACK_ENCODING);
+ }
+ if (!encoding) {
+ /*
+ * Fallback to internal encoding that always converts all bytes.
+ * Should only happen when a filename isn't UTF-8 and we've not got
+ * our encodings initialised for some reason.
+ */
+
+ encoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ }
+
+ char *converted = Tcl_ExternalToUtfDString(encoding,
+ (const char *) inputBytes, inputLength, dstPtr);
+ Tcl_FreeEncoding(encoding);
+ return converted;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
* CanonicalPath --
*
* This function computes the canonical path from a directory and file
@@ -873,7 +991,7 @@ CanonicalPath(
static inline ZipEntry *
ZipFSLookup(
- char *filename)
+ const char *filename)
{
Tcl_HashEntry *hPtr;
ZipEntry *z = NULL;
@@ -1064,7 +1182,7 @@ ZipFSFindTOC(
ZipFile *zf)
{
size_t i;
- unsigned char *p, *q;
+ const unsigned char *p, *q;
const unsigned char *start = zf->data;
const unsigned char *end = zf->data + zf->length;
@@ -1121,7 +1239,7 @@ ZipFSFindTOC(
q = zf->data + ZipReadInt(start, end, p + ZIP_CENTRAL_DIRSTART_OFFS);
p -= ZipReadInt(start, end, p + ZIP_CENTRAL_DIRSIZE_OFFS);
- if ((p < zf->data) || (p > zf->data + zf->length)
+ if ((p < q) || (p < zf->data) || (p > zf->data + zf->length)
|| (q < zf->data) || (q > zf->data + zf->length)) {
if (!needZip) {
zf->baseOffset = zf->passOffset = zf->length;
@@ -1166,10 +1284,13 @@ ZipFSFindTOC(
q = zf->data + zf->baseOffset;
if ((zf->baseOffset >= 6) &&
(ZipReadInt(start, end, q - 4) == ZIP_PASSWORD_END_SIG)) {
+ const unsigned char *passPtr;
+
i = q[-5];
- if (q - 5 - i > zf->data) {
+ passPtr = q - 5 - i;
+ if (passPtr >= start && passPtr + i < end) {
zf->passBuf[0] = i;
- memcpy(zf->passBuf + 1, q - 5 - i, i);
+ memcpy(zf->passBuf + 1, passPtr, i);
zf->passOffset -= i ? (5 + i) : 0;
}
}
@@ -1449,9 +1570,8 @@ ZipFSCatalogFilesystem(
* Validate the TOC data. If that's bad, things fall apart.
*/
- if (zf0->baseOffset < 0 || zf0->baseOffset >= zf0->length ||
- zf0->passOffset < 0 || zf0->passOffset >= zf0->length ||
- zf0->directoryOffset < 0 || zf0->directoryOffset >= zf0->length) {
+ if (zf0->baseOffset >= zf0->length || zf0->passOffset >= zf0->length ||
+ zf0->directoryOffset >= zf0->length) {
ZIPFS_ERROR(interp, "bad zip data");
ZIPFS_ERROR_CODE(interp, "BAD_ZIP");
return TCL_ERROR;
@@ -1499,9 +1619,11 @@ ZipFSCatalogFilesystem(
zf->mountPoint = (char *) Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
Tcl_CreateExitHandler(ZipfsExitHandler, zf);
zf->mountPointLen = strlen(zf->mountPoint);
+
zf->nameLength = strlen(zipname);
zf->name = (char *) Tcl_Alloc(zf->nameLength + 1);
memcpy(zf->name, zipname, zf->nameLength + 1);
+
Tcl_SetHashValue(hPtr, zf);
if ((zf->passBuf[0] == 0) && pwlen) {
int k = 0;
@@ -1542,9 +1664,7 @@ ZipFSCatalogFilesystem(
pathlen = ZipReadShort(start, end, q + ZIP_CENTRAL_PATHLEN_OFFS);
comlen = ZipReadShort(start, end, q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
extra = ZipReadShort(start, end, q + ZIP_CENTRAL_EXTRALEN_OFFS);
- Tcl_DStringSetLength(&ds, 0);
- Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen);
- path = Tcl_DStringValue(&ds);
+ path = DecodeZipEntryText(q + ZIP_CENTRAL_HEADER_LEN, pathlen, &ds);
if ((pathlen > 0) && (path[pathlen - 1] == '/')) {
Tcl_DStringSetLength(&ds, pathlen - 1);
path = Tcl_DStringValue(&ds);
@@ -1734,6 +1854,10 @@ ZipfsSetup(void)
Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS);
ZipFS.idCount = 1;
ZipFS.wrmax = DEFAULT_WRITE_MAX_SIZE;
+ ZipFS.fallbackEntryEncoding =
+ Tcl_Alloc(strlen(ZIPFS_FALLBACK_ENCODING) + 1);
+ strcpy(ZipFS.fallbackEntryEncoding, ZIPFS_FALLBACK_ENCODING);
+ ZipFS.utf8 = Tcl_GetEncoding(NULL, "utf-8");
ZipFS.initialized = 1;
}
@@ -1763,17 +1887,28 @@ ListMountPoints(
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
ZipFile *zf;
+ Tcl_Obj *resultList;
+
+ if (!interp) {
+ /*
+ * Are there any entries in the zipHash? Don't need to enumerate them
+ * all to know.
+ */
+ return (ZipFS.zipHash.numEntries ? TCL_OK : TCL_BREAK);
+ }
+
+ resultList = Tcl_NewObj();
for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
hPtr = Tcl_NextHashEntry(&search)) {
- if (!interp) {
- return TCL_OK;
- }
zf = (ZipFile *) Tcl_GetHashValue(hPtr);
- Tcl_AppendElement(interp, zf->mountPoint);
- Tcl_AppendElement(interp, zf->name);
+ Tcl_ListObjAppendElement(NULL, resultList, Tcl_NewStringObj(
+ zf->mountPoint, -1));
+ Tcl_ListObjAppendElement(NULL, resultList, Tcl_NewStringObj(
+ zf->name, -1));
}
- return (interp ? TCL_OK : TCL_BREAK);
+ Tcl_SetObjResult(interp, resultList);
+ return TCL_OK;
}
/*
@@ -1969,7 +2104,6 @@ TclZipfs_MountBuffer(
zf->data = data;
zf->ptrToFree = NULL;
}
- zf->passBuf[0] = 0; /* stop valgrind cries */
if (ZipFSFindTOC(interp, 0, zf) != TCL_OK) {
return TCL_ERROR;
}
@@ -2225,7 +2359,6 @@ ZipFSUnmountObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
-
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "zipfile");
return TCL_ERROR;
@@ -2258,35 +2391,35 @@ ZipFSMkKeyObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int len, i = 0;
- char *pw, passBuf[264];
+ const char *pw;
+ Tcl_Obj *passObj;
+ unsigned char *passBuf;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "password");
return TCL_ERROR;
}
- pw = TclGetString(objv[1]);
- len = strlen(pw);
+ pw = TclGetStringFromObj(objv[1], &len);
if (len == 0) {
return TCL_OK;
}
if (IsPasswordValid(interp, pw, len) != TCL_OK) {
return TCL_ERROR;
}
+
+ passObj = Tcl_NewByteArrayObj(NULL, 264);
+ passBuf = Tcl_GetByteArrayFromObj(passObj, (int *)NULL);
while (len > 0) {
int ch = pw[len - 1];
- passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
- i++;
+ passBuf[i++] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
len--;
}
passBuf[i] = i;
- ++i;
- passBuf[i++] = (char) ZIP_PASSWORD_END_SIG;
- passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
- passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
- passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
- passBuf[i] = '\0';
- Tcl_AppendResult(interp, passBuf, (char *) NULL);
+ i++;
+ ZipWriteInt(passBuf, passBuf + 264, passBuf + i, ZIP_PASSWORD_END_SIG);
+ Tcl_SetByteArrayLength(passObj, i + 4);
+ Tcl_SetObjResult(interp, passObj);
return TCL_OK;
}
@@ -2344,6 +2477,9 @@ RandomChar(
* input file is added to the given fileHash table for later creation of
* the central ZIP directory.
*
+ * Tcl *always* encodes filenames in the ZIP as UTF-8. Similarly, it
+ * would always encode comments as UTF-8, if it supported comments.
+ *
* Results:
* A standard Tcl result.
*
@@ -2358,7 +2494,8 @@ static int
ZipAddFile(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *pathObj, /* Actual name of the file to add. */
- const char *name, /* Name to use in the ZIP archive. */
+ const char *name, /* Name to use in the ZIP archive, in Tcl's
+ * internal encoding. */
Tcl_Channel out, /* The open ZIP archive being built. */
const char *passwd, /* Password for encoding the file, or NULL if
* the file is to be unprotected. */
@@ -2373,7 +2510,10 @@ ZipAddFile(
Tcl_HashEntry *hPtr;
ZipEntry *z;
z_stream stream;
- const char *zpath;
+ Tcl_DString zpathDs; /* Buffer for the encoded filename. */
+ const char *zpathExt; /* Filename in external encoding (true
+ * UTF-8). */
+ const char *zpathTcl; /* Filename in Tcl's internal encoding. */
int crc, flush, zpathlen;
size_t nbyte, nbytecompr, len, olen, align = 0;
long long headerStartOffset, dataStartOffset, dataEndOffset;
@@ -2386,23 +2526,31 @@ ZipAddFile(
* nothing to do.
*/
- zpath = name;
- while (zpath && zpath[0] == '/') {
- zpath++;
+ zpathTcl = name;
+ while (zpathTcl && zpathTcl[0] == '/') {
+ zpathTcl++;
}
- if (!zpath || (zpath[0] == '\0')) {
+ if (!zpathTcl || (zpathTcl[0] == '\0')) {
return TCL_OK;
}
- zpathlen = strlen(zpath);
+ /*
+ * Convert to encoded form. Note that we use strlen() here; if someone's
+ * crazy enough to embed NULs in filenames, they deserve what they get!
+ */
+
+ zpathExt = Tcl_UtfToExternalDString(ZipFS.utf8, zpathTcl, -1, &zpathDs);
+ zpathlen = strlen(zpathExt);
if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"path too long for \"%s\"", TclGetString(pathObj)));
ZIPFS_ERROR_CODE(interp, "PATH_LEN");
+ Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
in = Tcl_FSOpenFileChannel(interp, pathObj, "rb", 0);
if (!in) {
+ Tcl_DStringFree(&zpathDs);
#ifdef _WIN32
/* hopefully a directory */
if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) {
@@ -2430,6 +2578,7 @@ ZipAddFile(
while (1) {
len = Tcl_Read(in, buf, bufsize);
if (len == ERROR_LENGTH) {
+ Tcl_DStringFree(&zpathDs);
if (nbyte == 0 && errno == EISDIR) {
Tcl_Close(interp, in);
return TCL_OK;
@@ -2450,6 +2599,7 @@ ZipAddFile(
Tcl_SetObjResult(interp, Tcl_ObjPrintf("seek error on \"%s\": %s",
TclGetString(pathObj), Tcl_PosixError(interp)));
Tcl_Close(interp, in);
+ Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
@@ -2466,7 +2616,7 @@ ZipAddFile(
*/
memset(buf, '\0', ZIP_LOCAL_HEADER_LEN);
- memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen);
+ memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpathExt, zpathlen);
len = zpathlen + ZIP_LOCAL_HEADER_LEN;
if ((size_t) Tcl_Write(out, buf, len) != len) {
writeErrorWithChannelOpen:
@@ -2474,6 +2624,7 @@ ZipAddFile(
"write error on \"%s\": %s",
TclGetString(pathObj), Tcl_PosixError(interp)));
Tcl_Close(interp, in);
+ Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
@@ -2550,6 +2701,7 @@ ZipAddFile(
"compression init error on \"%s\"", TclGetString(pathObj)));
ZIPFS_ERROR_CODE(interp, "DEFLATE_INIT");
Tcl_Close(interp, in);
+ Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
@@ -2572,6 +2724,7 @@ ZipAddFile(
ZIPFS_ERROR_CODE(interp, "DEFLATE");
deflateEnd(&stream);
Tcl_Close(interp, in);
+ Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
olen = sizeof(obuf) - stream.avail_out;
@@ -2612,6 +2765,7 @@ ZipAddFile(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"seek error: %s", Tcl_PosixError(interp)));
Tcl_Close(interp, in);
+ Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
nbytecompr = (passwd ? 12 : 0);
@@ -2647,8 +2801,10 @@ ZipAddFile(
Tcl_TruncateChannel(out, dataEndOffset);
}
Tcl_Close(interp, in);
+ Tcl_DStringFree(&zpathDs);
+ zpathExt = NULL;
- hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew);
+ hPtr = Tcl_CreateHashEntry(fileHash, zpathTcl, &isNew);
if (!isNew) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"non-unique path name \"%s\"", TclGetString(pathObj)));
@@ -2745,8 +2901,8 @@ ZipFSFind(
* should be skipped.
*
* Returns:
- * Pointer to the name, which will be in memory owned by one of the
- * argument objects.
+ * Pointer to the name (in Tcl's internal encoding), which will be in
+ * memory owned by one of the argument objects.
*
* Side effects:
* None (if Tcl_Objs have string representations)
@@ -2759,8 +2915,10 @@ ComputeNameInArchive(
Tcl_Obj *pathObj, /* The path to the origin file */
Tcl_Obj *directNameObj, /* User-specified name for use in the ZIP
* archive */
- const char *strip, /* A prefix to strip */
- int slen) /* The length of the prefix */
+ const char *strip, /* A prefix to strip; may be NULL if no
+ * stripping need be done. */
+ int slen) /* The length of the prefix; must be 0 if no
+ * stripping need be done. */
{
const char *name;
int len;
@@ -2798,6 +2956,9 @@ ComputeNameInArchive(
* file. It's the core of the implementation of [zipfs mkzip], [zipfs
* mkimg], [zipfs lmkzip] and [zipfs lmkimg].
*
+ * Tcl *always* encodes filenames in the ZIP as UTF-8. Similarly, it
+ * would always encode comments as UTF-8, if it supported comments.
+ *
* Results:
* A standard Tcl result.
*
@@ -3010,6 +3171,9 @@ ZipFSMkZipOrImg(
dataStartOffset = Tcl_Tell(out);
if (mappingList == NULL && stripPrefix != NULL) {
strip = TclGetStringFromObj(stripPrefix, &slen);
+ if (!slen) {
+ strip = NULL;
+ }
}
for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) {
Tcl_Obj *pathObj = lobjv[i];
@@ -3034,25 +3198,27 @@ ZipFSMkZipOrImg(
for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) {
const char *name = ComputeNameInArchive(lobjv[i],
(mappingList ? lobjv[i + 1] : NULL), strip, slen);
+ Tcl_DString ds;
- if (name[0] == '\0') {
- continue;
- }
hPtr = Tcl_FindHashEntry(&fileHash, name);
if (!hPtr) {
continue;
}
z = (ZipEntry *) Tcl_GetHashValue(hPtr);
- len = strlen(z->name);
+
+ name = Tcl_UtfToExternalDString(ZipFS.utf8, z->name, -1, &ds);
+ len = Tcl_DStringLength(&ds);
SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
z, len, dataStartOffset);
if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN)
!= ZIP_CENTRAL_HEADER_LEN)
- || ((size_t) Tcl_Write(out, z->name, len) != len)) {
+ || ((size_t) Tcl_Write(out, name, len) != len)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"write error: %s", Tcl_PosixError(interp)));
+ Tcl_DStringFree(&ds);
goto done;
}
+ Tcl_DStringFree(&ds);
count++;
}
@@ -3733,7 +3899,7 @@ TclZipfs_TclLibrary(void)
#if !defined(STATIC_BUILD)
#if defined(_WIN32) || defined(__CYGWIN__)
- hModule = TclWinGetTclInstance();
+ hModule = (HMODULE)TclWinGetTclInstance();
GetModuleFileNameW(hModule, wName, MAX_PATH);
#ifdef __CYGWIN__
cygwin_conv_path(3, wName, dllName, sizeof(dllName));
@@ -4674,7 +4840,6 @@ ZipFSOpenFileChannelProc(
{
int trunc = (mode & O_TRUNC) != 0;
int wr = (mode & (O_WRONLY | O_RDWR)) != 0;
- int len;
pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (!pathPtr) {
@@ -4695,8 +4860,7 @@ ZipFSOpenFileChannelProc(
return NULL;
}
- return ZipChannelOpen(interp, TclGetStringFromObj(pathPtr, &len), wr,
- trunc);
+ return ZipChannelOpen(interp, TclGetString(pathPtr), wr, trunc);
}
/*
@@ -4721,13 +4885,11 @@ ZipFSStatProc(
Tcl_Obj *pathPtr,
Tcl_StatBuf *buf)
{
- int len;
-
pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (!pathPtr) {
return -1;
}
- return ZipEntryStat(TclGetStringFromObj(pathPtr, &len), buf);
+ return ZipEntryStat(TclGetString(pathPtr), buf);
}
/*
@@ -4752,13 +4914,11 @@ ZipFSAccessProc(
Tcl_Obj *pathPtr,
int mode)
{
- int len;
-
pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (!pathPtr) {
return -1;
}
- return ZipEntryAccess(TclGetStringFromObj(pathPtr, &len), mode);
+ return ZipEntryAccess(TclGetString(pathPtr), mode);
}
/*
@@ -4850,7 +5010,7 @@ ZipFSMatchInDirectoryProc(
Tcl_HashSearch search;
Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
int scnt, l, dirOnly = -1, prefixLen, strip = 0, mounts = 0;
- size_t len;
+ int len;
char *pat, *prefix, *path;
Tcl_DString dsPref, *prefixBuf = NULL;
@@ -4872,8 +5032,7 @@ ZipFSMatchInDirectoryProc(
* The (normalized) path we're searching.
*/
- path = TclGetString(normPathPtr);
- len = normPathPtr->length;
+ path = TclGetStringFromObj(normPathPtr, &len);
Tcl_DStringInit(&dsPref);
if (strcmp(prefix, path) == 0) {
@@ -4991,6 +5150,13 @@ ZipFSMatchMountPoints(
const char *path = TclGetStringFromObj(normPathPtr, &normLength);
size_t len = (size_t) normLength;
+ if (len < 1) {
+ /*
+ * Shouldn't happen. But "shouldn't"...
+ */
+
+ return;
+ }
l = CountSlashes(path);
if (path[len - 1] == '/') {
len--;
@@ -5061,22 +5227,18 @@ ZipFSPathInFilesystemProc(
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
- int ret = -1;
- size_t len;
+ int ret = -1, len;
char *path;
pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (!pathPtr) {
return -1;
}
-
- path = TclGetString(pathPtr);
+ path = TclGetStringFromObj(pathPtr, &len);
if (strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) != 0) {
return -1;
}
- len = pathPtr->length;
-
ReadLock();
hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
if (hPtr) {
@@ -5094,12 +5256,13 @@ ZipFSPathInFilesystemProc(
for (z = zf->topEnts; z != NULL; z = z->tnext) {
size_t lenz = strlen(z->name);
- if ((len >= lenz) && (strncmp(path, z->name, lenz) == 0)) {
+ if (((size_t) len >= lenz) &&
+ (strncmp(path, z->name, lenz) == 0)) {
ret = TCL_OK;
goto endloop;
}
}
- } else if ((len >= zf->mountPointLen) &&
+ } else if (((size_t) len >= zf->mountPointLen) &&
(strncmp(path, zf->mountPoint, zf->mountPointLen) == 0)) {
ret = TCL_OK;
break;
@@ -5508,6 +5671,8 @@ TclZipfs_Init(
if (!Tcl_IsSafe(interp)) {
Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
TCL_LINK_INT);
+ Tcl_LinkVar(interp, "::tcl::zipfs::fallbackEntryEncoding",
+ (char *) &ZipFS.fallbackEntryEncoding, TCL_LINK_STRING);
}
ensemble = TclMakeEnsemble(interp, "zipfs",
Tcl_IsSafe(interp) ? (initMap + 4) : initMap);
diff --git a/library/safe.tcl b/library/safe.tcl
index 3bdf728..1bc7d6a 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -1009,8 +1009,8 @@ proc ::safe::AliasLoad {child file args} {
return -code error $msg
}
- # package name (can be empty if file is not).
- set package [lindex $args 0]
+ # prefix (can be empty if file is not).
+ set prefix [lindex $args 0]
namespace upvar ::safe [VarName $child] state
@@ -1022,23 +1022,23 @@ proc ::safe::AliasLoad {child file args} {
# authorize that.
if {!$state(nestedok)} {
Log $child "loading to a sub interp (nestedok)\
- disabled (trying to load $package to $target)"
+ disabled (trying to load $prefix to $target)"
return -code error "permission denied (nested load)"
}
}
# Determine what kind of load is requested
if {$file eq ""} {
- # static package loading
- if {$package eq ""} {
- set msg "load error: empty filename and no package name"
+ # static loading
+ if {$prefix eq ""} {
+ set msg "load error: empty filename and no prefix"
Log $child $msg
return -code error $msg
}
if {!$state(staticsok)} {
- Log $child "static packages loading disabled\
- (trying to load $package to $target)"
- return -code error "permission denied (static package)"
+ Log $child "static loading disabled\
+ (trying to load $prefix to $target)"
+ return -code error "permission denied (static library)"
}
} else {
# file loading
@@ -1061,10 +1061,10 @@ proc ::safe::AliasLoad {child file args} {
}
try {
- return [::interp invokehidden $child load $file $package $target]
+ return [::interp invokehidden $child load $file $prefix $target]
} on error msg {
- # Some packages return no error message.
- set msg0 "load of binary library for package $package failed"
+ # Some libraries return no error message.
+ set msg0 "load of library for prefix $prefix failed"
if {$msg eq {}} {
set msg $msg0
} else {
diff --git a/tests/load.test b/tests/load.test
index 7978f64..1ee2bf5 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -47,28 +47,28 @@ testConstraint testsimplefilesystem \
test load-1.1 {basic errors} -returnCodes error -body {
load
-} -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?"}
+} -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"}
test load-1.2 {basic errors} -returnCodes error -body {
load a b c d
-} -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?"}
+} -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"}
test load-1.3 {basic errors} -returnCodes error -body {
load a b foobar
} -result {could not find interpreter "foobar"}
test load-1.4 {basic errors} -returnCodes error -body {
load -global {}
-} -result {must specify either file name or package name}
+} -result {must specify either file name or prefix}
test load-1.5 {basic errors} -returnCodes error -body {
load -lazy {} {}
-} -result {must specify either file name or package name}
+} -result {must specify either file name or prefix}
test load-1.6 {basic errors} -returnCodes error -body {
load {} Unknown
-} -result {package "Unknown" isn't loaded statically}
+} -result {no library with prefix "Unknown" is loaded statically}
test load-1.7 {basic errors} -returnCodes error -body {
load -abc foo
} -result {bad option "-abc": must be -global, -lazy, or --}
test load-1.8 {basic errors} -returnCodes error -body {
load -global
-} -result {couldn't figure out package name for -global}
+} -result {couldn't figure out prefix for -global}
test load-2.1 {basic loading, with guess for package name} \
[list $dll $loaded] {
@@ -84,17 +84,17 @@ test load-2.2 {loading into a safe interpreter, with package name conversion} \
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \
-body {
- list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
+ list [catch {load [file join $testDir pkgc$ext] Foo} msg] $msg $errorCode
} -match glob \
-result [list 1 {cannot find symbol "Foo_Init"*} \
{TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
-} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}
+} {1 {can't use library in a safe interpreter: no Pkga_SafeInit procedure}}
test load-3.1 {error in _Init procedure, same interpreter} \
[list $dll $loaded] {
- list [catch {load [file join $testDir pkge$ext] pkge} msg] \
+ list [catch {load [file join $testDir pkge$ext] Pkge} msg] \
$msg $::errorInfo $::errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
while executing
@@ -102,14 +102,14 @@ test load-3.1 {error in _Init procedure, same interpreter} \
invoked from within
"if 44 {open non_existent}"
invoked from within
-"load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}}
+"load [file join $testDir pkge$ext] Pkge"} {POSIX ENOENT {no such file or directory}}}
test load-3.2 {error in _Init procedure, child interpreter} \
[list $dll $loaded] {
catch {interp delete x}
interp create x
set ::errorCode foo
set ::errorInfo bar
- set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \
+ set result [list [catch {load [file join $testDir pkge$ext] Pkge x} msg] \
$msg $::errorInfo $::errorCode]
interp delete x
set result
@@ -119,16 +119,16 @@ test load-3.2 {error in _Init procedure, child interpreter} \
invoked from within
"if 44 {open non_existent}"
invoked from within
-"load [file join $testDir pkge$ext] pkge x"} {POSIX ENOENT {no such file or directory}}}
+"load [file join $testDir pkge$ext] Pkge x"} {POSIX ENOENT {no such file or directory}}}
test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
- list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
+ list [catch {load [file join $testDir pkga$ext] Pkga} msg] $msg
} {0 {}}
test load-4.2 {reloading package into same interpreter} -setup {
catch {load [file join $testDir pkga$ext] Pkga}
} -constraints [list $dll $loaded] -returnCodes error -body {
load [file join $testDir pkga$ext] Pkgb
-} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""
+} -result "file \"[file join $testDir pkga$ext]\" is already loaded for prefix \"Pkga\""
test load-5.1 {file name not specified and no static package: pick default} -setup {
catch {interp delete x}
@@ -153,8 +153,8 @@ test load-6.1 {errors loading file} [list $dll $loaded] {
test load-7.1 {Tcl_StaticPackage procedure} [list teststaticpkg] {
set x "not loaded"
teststaticpkg Test 1 0
- load {} test
- load {} test child
+ load {} Test
+ load {} Test child
list [set x] [child eval set x]
} {loaded loaded}
test load-7.2 {Tcl_StaticPackage procedure} [list teststaticpkg] {
@@ -164,11 +164,11 @@ test load-7.2 {Tcl_StaticPackage procedure} [list teststaticpkg] {
child eval {set x "not loaded"}
list [catch {load {} Another child} msg] $msg \
[child eval set x] [set x]
-} {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
+} {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] {
set x "not loaded"
teststaticpkg More 0 1
- load {} more
+ load {} More
set x
} {not loaded}
catch {load [file join $testDir pkga$ext] Pkga}
@@ -234,7 +234,7 @@ test load-10.1 {load from vfs} -setup {
cd $testDir
testsimplefilesystem 1
} -constraints [list $dll $loaded testsimplefilesystem] -body {
- list [catch {load simplefs:/pkgd$ext PKGD} msg] $msg
+ list [catch {load simplefs:/pkgd$ext Pkgd} msg] $msg
} -result {0 {}} -cleanup {
testsimplefilesystem 0
cd $dir
diff --git a/tests/safe.test b/tests/safe.test
index db881c2..8fca594 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -1159,58 +1159,58 @@ 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 Safepkg1 0 0}
+catch {teststaticpkg Safepfx1 0 0}
test safe-10.1 {testing statics loading} -constraints tcl::test -setup {
set i [safe::interpCreate]
} -body {
- interp eval $i {load {} Safepkg1}
+ interp eval $i {load {} Safepfx1}
} -returnCodes error -cleanup {
safe::interpDelete $i
-} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
+} -result {load of library for prefix Safepfx1 failed: can't use library in a safe interpreter: no Safepfx1_SafeInit procedure}
test safe-10.1.1 {testing statics loading} -constraints tcl::test -setup {
set i [safe::interpCreate]
} -body {
- catch {interp eval $i {load {} Safepkg1}} m o
+ catch {interp eval $i {load {} Safepfx1}} m o
dict get $o -errorinfo
} -returnCodes ok -cleanup {
unset -nocomplain m o
safe::interpDelete $i
-} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
+} -result {load of library for prefix Safepfx1 failed: can't use library in a safe interpreter: no Safepfx1_SafeInit procedure
invoked from within
-"load {} Safepkg1"
+"load {} Safepfx1"
invoked from within
-"interp eval $i {load {} Safepkg1}"}
+"interp eval $i {load {} Safepfx1}"}
test safe-10.2 {testing statics loading / -nostatics} -constraints tcl::test -body {
set i [safe::interpCreate -nostatics]
- interp eval $i {load {} Safepkg1}
+ interp eval $i {load {} Safepfx1}
} -returnCodes error -cleanup {
safe::interpDelete $i
-} -result {permission denied (static package)}
+} -result {permission denied (static library)}
test safe-10.3 {testing nested statics loading / no nested by default} -setup {
set i [safe::interpCreate]
} -constraints tcl::test -body {
- interp eval $i {interp create x; load {} Safepkg1 x}
+ interp eval $i {interp create x; load {} Safepfx1 x}
} -returnCodes error -cleanup {
safe::interpDelete $i
} -result {permission denied (nested load)}
test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints tcl::test -body {
set i [safe::interpCreate -nestedloadok]
- interp eval $i {interp create x; load {} Safepkg1 x}
+ interp eval $i {interp create x; load {} Safepfx1 x}
} -returnCodes error -cleanup {
safe::interpDelete $i
-} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
+} -result {load of library for prefix Safepfx1 failed: can't use library in a safe interpreter: no Safepfx1_SafeInit procedure}
test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints tcl::test -body {
set i [safe::interpCreate -nestedloadok]
- catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o
+ catch {interp eval $i {interp create x; load {} Safepfx1 x}} m o
dict get $o -errorinfo
} -returnCodes ok -cleanup {
unset -nocomplain m o
safe::interpDelete $i
-} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
+} -result {load of library for prefix Safepfx1 failed: can't use library in a safe interpreter: no Safepfx1_SafeInit procedure
invoked from within
-"load {} Safepkg1 x"
+"load {} Safepfx1 x"
invoked from within
-"interp eval $i {interp create x; load {} Safepkg1 x}"}
+"interp eval $i {interp create x; load {} Safepfx1 x}"}
test safe-11.1 {testing safe encoding} -setup {
set i [safe::interpCreate]
diff --git a/tests/unload.test b/tests/unload.test
index 29f534d..8f388a7 100644
--- a/tests/unload.test
+++ b/tests/unload.test
@@ -53,22 +53,22 @@ proc loadIfNotPresent {pkg args} {
# Basic tests: parameter testing...
test unload-1.1 {basic errors} -returnCodes error -body {
unload
-} -result {wrong # args: should be "unload ?-switch ...? fileName ?packageName? ?interp?"}
+} -result {wrong # args: should be "unload ?-switch ...? fileName ?prefix? ?interp?"}
test unload-1.2 {basic errors} -returnCodes error -body {
unload a b c d
-} -result {wrong # args: should be "unload ?-switch ...? fileName ?packageName? ?interp?"}
+} -result {wrong # args: should be "unload ?-switch ...? fileName ?prefix? ?interp?"}
test unload-1.3 {basic errors} -returnCodes error -body {
unload a b foobar
} -result {could not find interpreter "foobar"}
test unload-1.4 {basic errors} -returnCodes error -body {
unload {}
-} -result {must specify either file name or package name}
+} -result {must specify either file name or prefix}
test unload-1.5 {basic errors} -returnCodes error -body {
unload {} {}
-} -result {must specify either file name or package name}
+} -result {must specify either file name or prefix}
test unload-1.6 {basic errors} -returnCodes error -body {
unload {} Unknown
-} -result {package "Unknown" is loaded statically and cannot be unloaded}
+} -result {library with prefix "Unknown" is loaded statically and cannot be unloaded}
test unload-1.7 {-nocomplain switch} {
unload -nocomplain {} Unknown
} {}
@@ -142,7 +142,7 @@ test unload-3.1 {basic loading of non-unloadable package in a safe interpreter}
test unload-3.2 {basic loading of unloadable package in a safe interpreter} \
[list $dll $loaded] {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
- [load [file join $testDir pkgua$ext] pkgua child] \
+ [load [file join $testDir pkgua$ext] Pkgua child] \
[child eval pkgua_eq abc def] \
[lsort [child eval info commands pkgua_*]] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
@@ -189,7 +189,7 @@ test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, w
}
} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
- [unload [file join $testDir pkgua$ext] pKgUa child] \
+ [unload [file join $testDir pkgua$ext] Pkgua child] \
[child eval info commands pkgua_*] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{.. . .} {} {} {.. .. ..}}
@@ -224,7 +224,7 @@ test unload-4.2 {basic loading of unloadable package in a safe interpreter} -set
incr load(C)
} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
- [load [file join $testDir pkgua$ext] pkgua child] \
+ [load [file join $testDir pkgua$ext] Pkgua child] \
[child eval pkgua_eq abc def] \
[lsort [child eval info commands pkgua_*]] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
@@ -234,7 +234,7 @@ test unload-4.3 {basic loading of unloadable package in a second trusted interpr
incr load(T)
} -constraints [list $dll $loaded] -body {
list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
- [load [file join $testDir pkgua$ext] pkgua child-trusted] \
+ [load [file join $testDir pkgua$ext] Pkgua child-trusted] \
[child-trusted eval pkgua_eq abc def] \
[lsort [child-trusted eval info commands pkgua_*]] \
[child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
@@ -291,7 +291,7 @@ test unload-5.1 {unload a module loaded from vfs} \
set dir [pwd]
cd $testDir
testsimplefilesystem 1
- load simplefs:/pkgua$ext pkgua
+ load simplefs:/pkgua$ext Pkgua
} \
-body {
list [catch {unload simplefs:/pkgua$ext} msg] $msg
diff --git a/tests/zipfs.test b/tests/zipfs.test
index eba2a1e..40655b4 100644
--- a/tests/zipfs.test
+++ b/tests/zipfs.test
@@ -396,6 +396,11 @@ test zipfs-5.3 {zipfs mount_data: short data} -constraints zipfs -body {
test zipfs-5.4 {zipfs mount_data: bad arg count} -constraints zipfs -body {
zipfs mount_data gorp {} foobar
} -returnCodes error -result {wrong # args: should be "zipfs mount_data ?mountpoint? ?data?"}
+
+test zipfs-6.1 {zipfs mkkey} -constraints zipfs -body {
+ binary scan [zipfs mkkey gorp] cu* x
+ return $x
+} -result {224 226 111 103 4 80 75 90 90}
::tcltest::cleanupTests
return
diff --git a/tools/README b/tools/README
index 87a9af4..6e5b20e 100644
--- a/tools/README
+++ b/tools/README
@@ -9,17 +9,7 @@ uniClass.tcl -- Script for generating regexp class tables from the Tcl
"string is" classes
Generating HTML files.
-The tcl-tk-man-html.tcl script from Robert Critchlow
-generates a nice set of HTML with good cross references.
-Use it like
- tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl9.0
This script is very picky about the organization of man pages,
effectively acting as a style enforcer.
-
-Generating Windows Help Files:
-1) Build tcl in the ../unix directory
-2) On UNIX, (after autoconf and configure), do
- make
- this converts the Nroff to RTF files.
-2) On Windows, convert the RTF to a Help doc, do
- nmake helpfile
+The resulting documentation can be found at
+ /tmp/dist/tcl<version>/html
generated by cgit v0.12 at 2024-10-23 15:25:31 (GMT)