summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2021-03-19 11:18:08 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2021-03-19 11:18:08 (GMT)
commit1df5f1053536d20ad31fac5c678647258b61c24f (patch)
tree430c0be0edec839b9e2866058b3e2d05627bd73c
parent6691d36fcb40c6b22b8586ba868469a34cb69399 (diff)
parentc39345b47aa9604e3ffb82599ee15be9cbce57f6 (diff)
downloadtcl-1df5f1053536d20ad31fac5c678647258b61c24f.zip
tcl-1df5f1053536d20ad31fac5c678647258b61c24f.tar.gz
tcl-1df5f1053536d20ad31fac5c678647258b61c24f.tar.bz2
Merge 8.7
-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/unload.n37
-rw-r--r--generic/tcl.decls2
-rw-r--r--generic/tcl.h2
-rw-r--r--generic/tclConfig.c2
-rw-r--r--generic/tclEncoding.c55
-rw-r--r--generic/tclIndexObj.c2
-rw-r--r--generic/tclInt.decls2
-rw-r--r--generic/tclIntDecls.h4
-rw-r--r--generic/tclLoad.c284
-rw-r--r--generic/tclPkgConfig.c2
-rw-r--r--generic/tclTest.c2
-rw-r--r--generic/tclZipfs.c199
-rw-r--r--library/safe.tcl24
-rw-r--r--tests/load.test20
-rw-r--r--tests/safe.test32
-rw-r--r--tests/unload.test10
20 files changed, 471 insertions, 297 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/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 790d9fb..293368d 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 b02efcf..fbad71c 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/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 70dc321..a1b6fe5 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -512,7 +512,7 @@ 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 */
+#define TCL_ENCODING_EXTERNAL 0x80 /* Converting from internal to external variant */
void
TclInitEncodingSubsystem(void)
@@ -1266,8 +1266,8 @@ Tcl_UtfToExternalDString(
flags = TCL_ENCODING_START | TCL_ENCODING_END;
while (1) {
result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
- srcLen, flags | TCL_ENCODING_EXTERNAL, &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) {
@@ -1368,8 +1368,8 @@ Tcl_UtfToExternal(
dstLen -= encodingPtr->nullSize;
result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
- flags | TCL_ENCODING_EXTERNAL, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
- dstCharsPtr);
+ flags | TCL_ENCODING_EXTERNAL, statePtr, dst, dstLen, srcReadPtr,
+ dstWrotePtr, dstCharsPtr);
if (encodingPtr->nullSize == 2) {
dst[*dstWrotePtr + 1] = '\0';
}
@@ -2182,23 +2182,32 @@ 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.
*/
+ if (flags & TCL_ENCODING_STOPONERROR) {
+ result = TCL_CONVERT_MULTIBYTE;
+ break;
+ }
ch = UCHAR(*src);
src += 1;
dst += Tcl_UniCharToUtf(ch, dst);
} else {
src += TclUtfToUCS4(src, &ch);
if ((ch | 0x7FF) == 0xDFFF) {
- /* A surrogate character is detected, handle especially */
+ /*
+ * A surrogate character is detected, handle especially.
+ */
+
int low = ch;
size_t 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;
+ *dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
+ *dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
+ *dst++ = (char) ((ch | 0x80) & 0xBF);
+ continue;
}
src += len;
dst += Tcl_UniCharToUtf(ch, dst);
@@ -2264,13 +2273,21 @@ Utf16ToUtfProc(
}
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 - ((flags & TCL_ENCODING_LE)?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;
}
@@ -2292,10 +2309,12 @@ Utf16ToUtfProc(
} 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 {
@@ -2905,7 +2924,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.
@@ -2950,7 +2971,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]
@@ -3008,7 +3029,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/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 eb18fd8..99d2aaa 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/tclIntDecls.h b/generic/tclIntDecls.h
index fc0a9a3..e57b295 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 */
@@ -844,7 +844,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 */
unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *lengthPtr); /* 259 */
} TclIntStubs;
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 364e97b..0a38249 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -13,19 +13,19 @@
#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
+ 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".
* Malloc-ed. */
@@ -35,57 +35,57 @@ 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
+ /* Next in list of all libraries loaded into
* this application process. NULL means end of
* list. */
} LoadedPackage;
/*
* TCL_THREADS
- * There is a global list of packages that is anchored at firstPackagePtr.
+ * There is a global list of libraries that is anchored at firstPackagePtr.
* Access to this list is governed by a mutex.
*/
static LoadedPackage *firstPackagePtr = NULL;
- /* First in list of all packages loaded into
+ /* First in list of all libraries loaded into
* this process. */
TCL_DECLARE_MUTEX(packageMutex)
/*
- * 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. */
+ * library. */
struct InterpPackage *nextPtr;
- /* Next package in this interpreter, or NULL
+ /* Next library in this interpreter, or NULL
* for end of list. */
} InterpPackage;
@@ -122,13 +122,13 @@ Tcl_LoadObjCmd(
{
Tcl_Interp *target;
LoadedPackage *pkgPtr, *defaultPtr;
- Tcl_DString pkgName, tmp, initName, safeInitName;
+ Tcl_DString pfx, tmp, initName, safeInitName;
Tcl_DString unloadName, safeUnloadName;
InterpPackage *ipFirstPtr, *ipPtr;
int code, namesMatch, filesMatch, offset;
const char *symbols[2];
Tcl_PackageInitProc *initProc;
- const char *p, *fullFileName, *packageName;
+ 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,39 +206,39 @@ 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);
defaultPtr = NULL;
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
- 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, pkgPtr->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))) {
+ if (filesMatch && (namesMatch || (prefix == NULL))) {
break;
}
if (namesMatch && (fullFileName[0] == 0)) {
@@ -246,12 +246,12 @@ Tcl_LoadObjCmd(
}
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, pkgPtr->prefix));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
"SPLITPERSONALITY", NULL);
code = TCL_ERROR;
@@ -265,8 +265,8 @@ Tcl_LoadObjCmd(
}
/*
- * 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.
*/
@@ -283,12 +283,12 @@ Tcl_LoadObjCmd(
if (pkgPtr == NULL) {
/*
* The desired file isn't currently loaded, so load it. It's an error
- * if the desired package is a static one.
+ * if 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,42 +346,42 @@ 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.
*/
@@ -397,16 +397,16 @@ Tcl_LoadObjCmd(
}
/*
- * Create a new record to describe this package.
+ * Create a new record to describe this library.
*/
pkgPtr = (LoadedPackage *)Tcl_Alloc(sizeof(LoadedPackage));
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);
+ len = Tcl_DStringLength(&pfx) + 1;
+ pkgPtr->prefix = (char *)Tcl_Alloc(len);
+ memcpy(pkgPtr->prefix, Tcl_DStringValue(&pfx), len);
pkgPtr->loadHandle = loadHandle;
pkgPtr->initProc = initProc;
pkgPtr->safeInitProc = (Tcl_PackageInitProc *)
@@ -435,15 +435,15 @@ 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) {
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", pkgPtr->prefix));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE",
NULL);
code = TCL_ERROR;
@@ -453,8 +453,8 @@ Tcl_LoadObjCmd(
} else {
if (pkgPtr->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",
+ pkgPtr->prefix));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
NULL);
code = TCL_ERROR;
@@ -485,7 +485,7 @@ 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.
@@ -500,8 +500,8 @@ Tcl_LoadObjCmd(
Tcl_MutexUnlock(&packageMutex);
/*
- * 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);
@@ -511,7 +511,7 @@ Tcl_LoadObjCmd(
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);
done:
- Tcl_DStringFree(&pkgName);
+ Tcl_DStringFree(&pfx);
Tcl_DStringFree(&initName);
Tcl_DStringFree(&safeInitName);
Tcl_DStringFree(&unloadName);
@@ -546,13 +546,13 @@ Tcl_UnloadObjCmd(
{
Tcl_Interp *target; /* Which interpreter to unload from. */
LoadedPackage *pkgPtr, *defaultPtr;
- Tcl_DString pkgName, tmp;
+ Tcl_DString pfx, tmp;
Tcl_PackageUnloadProc *unloadProc;
InterpPackage *ipFirstPtr, *ipPtr;
int i, index, code, complain = 1, keepLibrary = 0;
int trustedRefCount = -1, safeRefCount = -1;
const char *fullFileName = "";
- const char *packageName;
+ 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,13 +638,13 @@ 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);
@@ -653,26 +653,26 @@ Tcl_UnloadObjCmd(
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->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, pkgPtr->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))) {
+ if (filesMatch && (namesMatch || (prefix == NULL))) {
break;
}
if (namesMatch && (fullFileName[0] == 0)) {
@@ -685,12 +685,12 @@ Tcl_UnloadObjCmd(
Tcl_MutexUnlock(&packageMutex);
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;
@@ -710,8 +710,8 @@ 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.
*/
@@ -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(
@@ -770,7 +770,7 @@ Tcl_UnloadObjCmd(
}
/*
- * 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
@@ -890,7 +890,7 @@ 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);
@@ -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,28 +938,28 @@ 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;
/*
- * 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.
*/
@@ -967,14 +967,14 @@ Tcl_StaticPackage(
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
if ((pkgPtr->initProc == initProc)
&& (pkgPtr->safeInitProc == safeInitProc)
- && (strcmp(pkgPtr->packageName, pkgName) == 0)) {
+ && (strcmp(pkgPtr->prefix, prefix) == 0)) {
break;
}
}
Tcl_MutexUnlock(&packageMutex);
/*
- * 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.
*/
@@ -982,8 +982,8 @@ Tcl_StaticPackage(
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->prefix = (char *)Tcl_Alloc(strlen(prefix) + 1);
+ strcpy(pkgPtr->prefix, prefix);
pkgPtr->loadHandle = NULL;
pkgPtr->initProc = initProc;
pkgPtr->safeInitProc = safeInitProc;
@@ -996,7 +996,7 @@ Tcl_StaticPackage(
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.
*/
@@ -1008,7 +1008,7 @@ Tcl_StaticPackage(
}
/*
- * 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.
*/
@@ -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.
@@ -1048,8 +1048,8 @@ TclGetLoadedPackagesEx(
* 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;
@@ -1063,7 +1063,7 @@ TclGetLoadedPackagesEx(
for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
pkgPtr = pkgPtr->nextPtr) {
pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
- pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
+ pkgDesc[1] = Tcl_NewStringObj(pkgPtr->prefix, -1);
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewListObj(2, pkgDesc));
}
@@ -1079,15 +1079,15 @@ TclGetLoadedPackagesEx(
ipPtr = (InterpPackage *)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;
- if (!strcmp(packageName, pkgPtr->packageName)) {
+ if (!strcmp(prefix, pkgPtr->prefix)) {
resultObj = Tcl_NewStringObj(pkgPtr->fileName, -1);
break;
}
@@ -1100,7 +1100,7 @@ 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.
*/
@@ -1108,7 +1108,7 @@ TclGetLoadedPackagesEx(
for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
pkgPtr = ipPtr->pkgPtr;
pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
- pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
+ pkgDesc[1] = Tcl_NewStringObj(pkgPtr->prefix, -1);
Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc));
}
Tcl_SetObjResult(interp, resultObj);
@@ -1196,7 +1196,7 @@ TclFinalizeLoad(void)
#endif
Tcl_Free(pkgPtr->fileName);
- Tcl_Free(pkgPtr->packageName);
+ Tcl_Free(pkgPtr->prefix);
Tcl_Free(pkgPtr);
}
}
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 03bb581..a51f473 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/tclZipfs.c b/generic/tclZipfs.c
index aa83f28..d953bca 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
@@ -1546,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);
@@ -1738,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;
}
@@ -2357,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.
*
@@ -2371,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. */
@@ -2386,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;
@@ -2399,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) {
@@ -2443,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;
@@ -2463,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;
}
@@ -2479,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:
@@ -2487,6 +2624,7 @@ ZipAddFile(
"write error on \"%s\": %s",
TclGetString(pathObj), Tcl_PosixError(interp)));
Tcl_Close(interp, in);
+ Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
@@ -2563,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;
}
@@ -2585,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;
@@ -2625,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);
@@ -2660,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)));
@@ -2758,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)
@@ -2772,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;
@@ -2811,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.
*
@@ -3023,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];
@@ -3047,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++;
}
@@ -5518,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..d140aac 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 library 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 library 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..0ea96ce 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] {
@@ -90,7 +90,7 @@ test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded]
{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] {
@@ -128,7 +128,7 @@ 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}
@@ -164,7 +164,7 @@ 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
@@ -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..24b5e8d 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
} {}