summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/proc.n28
-rw-r--r--doc/zlib.n18
-rw-r--r--generic/tcl.h22
-rw-r--r--generic/tclCmdIL.c4
-rw-r--r--generic/tclExecute.c4
-rw-r--r--generic/tclParse.c164
-rw-r--r--generic/tclPkg.c2
-rw-r--r--generic/tclProc.c2
-rw-r--r--generic/tclStubLib.c20
-rw-r--r--generic/tclVar.c3
-rw-r--r--generic/tclZlib.c36
-rw-r--r--tests/dict.test7
-rw-r--r--tests/zlib.test20
-rwxr-xr-xunix/installManPage2
14 files changed, 179 insertions, 153 deletions
diff --git a/doc/proc.n b/doc/proc.n
index 129f4df..fdccaca 100644
--- a/doc/proc.n
+++ b/doc/proc.n
@@ -34,8 +34,9 @@ one or two fields. If there is only a single field in the specifier
then it is the name of the argument; if there are two fields, then
the first is the argument name and the second is its default value.
Arguments with default values that are followed by non-defaulted
-arguments become required arguments. In 8.6 this will be considered an
-error.
+arguments become required arguments; enough actual arguments must be
+supplied to allow all arguments up to and including the last required
+formal argument.
.PP
When \fIname\fR is invoked a local variable
will be created for each of the formal arguments to the procedure; its
@@ -48,11 +49,14 @@ actual arguments for all the
formal arguments that do not have defaults, and there must not be any extra
actual arguments.
Arguments with default values that are followed by non-defaulted
-arguments become required arguments (in 8.6 it will be considered an
-error).
+arguments become de-facto required arguments, though this may change
+in a future version of Tcl; portable code should ensure that all
+optional arguments come after all required arguments.
+.PP
There is one special case to permit procedures with
variable numbers of arguments. If the last formal argument has the name
-\fBargs\fR, then a call to the procedure may contain more actual arguments
+.QW \fBargs\fR ,
+then a call to the procedure may contain more actual arguments
than the procedure has formal arguments. In this case, all of the actual arguments
starting at the one that would be assigned to \fBargs\fR are combined into
a list (as if the \fBlist\fR command had been used); this combined value
@@ -80,6 +84,20 @@ If an error occurs while executing the procedure
body, then the procedure-as-a-whole will return that same error.
.SH EXAMPLES
.PP
+This is a procedure that takes two arguments and prints both their sum
+and their product. It also returns the string
+.QW OK
+to the caller as an explicit result.
+.PP
+.CS
+\fBproc\fR printSumProduct {x y} {
+ set sum [expr {$x + $y}]
+ set prod [expr {$x * $y}]
+ puts "sum is $sum, product is $prod"
+ return "OK"
+}
+.CE
+.PP
This is a procedure that accepts arbitrarily many arguments and prints
them out, one by one.
.PP
diff --git a/doc/zlib.n b/doc/zlib.n
index 9f3078d..fd29e0d 100644
--- a/doc/zlib.n
+++ b/doc/zlib.n
@@ -174,7 +174,11 @@ to the \fBzlib push\fR command:
.VS "TIP 400"
Sets the compression dictionary to use when working with compressing or
decompressing the data to be \fIbinData\fR. Not valid for transformations that
-work with gzip-format data.
+work with gzip-format data. The dictionary should consist of strings (byte
+sequences) that are likely to be encountered later in the data to be compressed,
+with the most commonly used strings preferably put towards the end of the
+dictionary. Tcl provides no mechanism for choosing a good such dictionary for
+a particular data sequence.
.VE
.TP
\fB\-header\fI dictionary\fR
@@ -207,11 +211,13 @@ compression algorithm depends on what format is being produced or consumed.
.TP
\fB\-dictionary\fI binData\fR
.VS "TIP 400"
-This read-write options gets or sets the compression dictionary to use when
-working with compressing or decompressing the data to be \fIbinData\fR. It is
-not valid for transformations that work with gzip-format data, and should not
-normally be set on compressing transformations other than at the point where
-the transformation is stacked.
+This read-write options gets or sets the initial compression dictionary to use
+when working with compressing or decompressing the data to be \fIbinData\fR.
+It is not valid for transformations that work with gzip-format data, and should
+not normally be set on compressing transformations other than at the point where
+the transformation is stacked. Note that this cannot be used to get the
+current active compression dictionary mid-stream, as that information is not
+exposed by the underlying library.
.VE
.TP
\fB\-flush\fI type\fR
diff --git a/generic/tcl.h b/generic/tcl.h
index c451579..3f293f0 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -144,6 +144,7 @@ extern "C" {
#if defined(__GNUC__) && (__GNUC__ > 2)
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
# define TCL_NORETURN __attribute__ ((noreturn))
+# define TCL_NOINLINE __attribute__ ((noinline))
# if defined(BUILD_tcl) || defined(BUILD_tk)
# define TCL_NORETURN1 __attribute__ ((noreturn))
# else
@@ -153,8 +154,10 @@ extern "C" {
# define TCL_FORMAT_PRINTF(a,b)
# if defined(_MSC_VER) && (_MSC_VER >= 1310)
# define TCL_NORETURN _declspec(noreturn)
+# define TCL_NOINLINE __declspec(noinline)
# else
# define TCL_NORETURN /* nothing */
+# define TCL_NOINLINE /* nothing */
# endif
# define TCL_NORETURN1 /* nothing */
#endif
@@ -2378,9 +2381,6 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
*----------------------------------------------------------------------------
* The following constant is used to test for older versions of Tcl in the
* stubs tables.
- *
- * Jan Nijtman's plus patch uses 0xFCA1BACF, so we need to pick a different
- * value since the stubs tables don't match.
*/
#define TCL_STUB_MAGIC ((int) 0xFCA3BACF)
@@ -2393,17 +2393,19 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
*/
const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version,
- int exact);
+ int exact, int magic);
const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
const char *version, int epoch, int revision);
-/*
- * When not using stubs, make it a macro.
- */
-
-#ifndef USE_TCL_STUBS
+#ifdef USE_TCL_STUBS
+#define Tcl_InitStubs(interp, version, exact) \
+ (Tcl_InitStubs)(interp, version, \
+ (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
+ TCL_STUB_MAGIC)
+#else
#define Tcl_InitStubs(interp, version, exact) \
- Tcl_PkgInitStubsCheck(interp, version, exact)
+ Tcl_PkgInitStubsCheck(interp, version, \
+ (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
#endif
/*
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 64cefa0..8fe453b 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1193,7 +1193,7 @@ InfoFrameCmd(
levelError:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad level \"%s\"", TclGetString(objv[1])));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_FRAME",
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
TclGetString(objv[1]), NULL);
code = TCL_ERROR;
goto done;
@@ -1628,7 +1628,7 @@ InfoLevelCmd(
levelError:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad level \"%s\"", TclGetString(objv[1])));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
TclGetString(objv[1]), NULL);
return TCL_ERROR;
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 1afe259..b9ba370 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -7723,6 +7723,7 @@ TEBCresume(
goto gotError;
}
}
+ Tcl_IncrRefCount(dictPtr);
if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
&keyPtrPtr) != TCL_OK) {
TRACE_ERROR(interp);
@@ -7735,6 +7736,7 @@ TEBCresume(
if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
&valuePtr) != TCL_OK) {
TRACE_ERROR(interp);
+ Tcl_DecrRefCount(dictPtr);
goto gotError;
}
varPtr = LOCAL(duiPtr->varIndices[i]);
@@ -7751,10 +7753,12 @@ TEBCresume(
duiPtr->varIndices[i]) == NULL) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
+ Tcl_DecrRefCount(dictPtr);
goto gotError;
}
CACHE_STACK_INFO();
}
+ TclDecrRefCount(dictPtr);
TRACE_APPEND(("OK\n"));
NEXT_INST_F(9, 0, 0);
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 95abc45..568024b 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -167,6 +167,8 @@ static int ParseTokens(const char *src, int numBytes, int mask,
int flags, Tcl_Parse *parsePtr);
static int ParseWhiteSpace(const char *src, int numBytes,
int *incompletePtr, char *typePtr);
+static int ParseAllWhiteSpace(const char *src, int numBytes,
+ int *incompletePtr);
/*
*----------------------------------------------------------------------
@@ -298,9 +300,43 @@ Tcl_ParseCommand(
*/
parsePtr->commandStart = src;
+ type = CHAR_TYPE(*src);
+ scanned = 1; /* Can't have missing whitepsace before first word. */
while (1) {
int expandWord = 0;
+ /* Are we at command termination? */
+
+ if ((numBytes == 0) || (type & terminators) != 0) {
+ parsePtr->term = src;
+ parsePtr->commandSize = src + (numBytes != 0)
+ - parsePtr->commandStart;
+ return TCL_OK;
+ }
+
+ /* Are we missing white space after previous word? */
+
+ if (scanned == 0) {
+ if (src[-1] == '"') {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra characters after close-quote", -1));
+ }
+ parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
+ } else {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra characters after close-brace", -1));
+ }
+ parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
+ }
+ parsePtr->term = src;
+ error:
+ Tcl_FreeParse(parsePtr);
+ parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;
+ return TCL_ERROR;
+ }
+
/*
* Create the token for the word.
*/
@@ -310,23 +346,6 @@ Tcl_ParseCommand(
tokenPtr = &parsePtr->tokenPtr[wordIndex];
tokenPtr->type = TCL_TOKEN_WORD;
- /*
- * Skip white space before the word. Also skip a backslash-newline
- * sequence: it should be treated just like white space.
- */
-
- scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
- src += scanned;
- numBytes -= scanned;
- if (numBytes == 0) {
- parsePtr->term = src;
- break;
- }
- if ((type & terminators) != 0) {
- parsePtr->term = src;
- src++;
- break;
- }
tokenPtr->start = src;
parsePtr->numTokens++;
parsePtr->numWords++;
@@ -546,52 +565,12 @@ Tcl_ParseCommand(
tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
}
- /*
- * Do two additional checks: (a) make sure we're really at the end of
- * a word (there might have been garbage left after a quoted or braced
- * word), and (b) check for the end of the command.
- */
+ /* Parse the whitespace between words. */
scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
- if (scanned) {
- src += scanned;
- numBytes -= scanned;
- continue;
- }
-
- if (numBytes == 0) {
- parsePtr->term = src;
- break;
- }
- if ((type & terminators) != 0) {
- parsePtr->term = src;
- src++;
- break;
- }
- if (src[-1] == '"') {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "extra characters after close-quote", -1));
- }
- parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
- } else {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "extra characters after close-brace", -1));
- }
- parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
- }
- parsePtr->term = src;
- goto error;
+ src += scanned;
+ numBytes -= scanned;
}
-
- parsePtr->commandSize = src - parsePtr->commandStart;
- return TCL_OK;
-
- error:
- Tcl_FreeParse(parsePtr);
- parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;
- return TCL_ERROR;
}
/*
@@ -733,23 +712,32 @@ ParseWhiteSpace(
*----------------------------------------------------------------------
*/
-int
-TclParseAllWhiteSpace(
+static int
+ParseAllWhiteSpace(
const char *src, /* First character to parse. */
- int numBytes) /* Max number of byes to scan */
+ int numBytes, /* Max number of byes to scan */
+ int *incompletePtr) /* Set true if parse is incomplete. */
{
- int dummy;
char type;
const char *p = src;
do {
- int scanned = ParseWhiteSpace(p, numBytes, &dummy, &type);
+ int scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type);
p += scanned;
numBytes -= scanned;
} while (numBytes && (*p == '\n') && (p++, --numBytes));
return (p-src);
}
+
+int
+TclParseAllWhiteSpace(
+ const char *src, /* First character to parse. */
+ int numBytes) /* Max number of byes to scan */
+{
+ int dummy;
+ return ParseAllWhiteSpace(src, numBytes, &dummy);
+}
/*
*----------------------------------------------------------------------
@@ -1021,17 +1009,12 @@ ParseComment(
* command. */
{
register const char *p = src;
+ int incomplete = parsePtr->incomplete;
while (numBytes) {
- char type;
- int scanned;
-
- do {
- scanned = ParseWhiteSpace(p, numBytes,
- &parsePtr->incomplete, &type);
- p += scanned;
- numBytes -= scanned;
- } while (numBytes && (*p == '\n') && (p++,numBytes--));
+ int scanned = ParseAllWhiteSpace(p, numBytes, &incomplete);
+ p += scanned;
+ numBytes -= scanned;
if ((numBytes == 0) || (*p != '#')) {
break;
@@ -1039,36 +1022,29 @@ ParseComment(
if (parsePtr->commentStart == NULL) {
parsePtr->commentStart = p;
}
-
+
+ p++;
+ numBytes--;
while (numBytes) {
+ if (*p == '\n') {
+ p++;
+ numBytes--;
+ break;
+ }
if (*p == '\\') {
- scanned = ParseWhiteSpace(p, numBytes, &parsePtr->incomplete,
- &type);
- if (scanned) {
- p += scanned;
- numBytes -= scanned;
- } else {
- /*
- * General backslash substitution in comments isn't part
- * of the formal spec, but test parse-15.47 and history
- * indicate that it has been the de facto rule. Don't
- * change it now.
- */
-
- TclParseBackslash(p, numBytes, &scanned, NULL);
- p += scanned;
- numBytes -= scanned;
- }
- } else {
p++;
numBytes--;
- if (p[-1] == '\n') {
+ if (numBytes == 0) {
break;
}
}
+ incomplete = (*p == '\n');
+ p++;
+ numBytes--;
}
parsePtr->commentSize = p - parsePtr->commentStart;
}
+ parsePtr->incomplete = incomplete;
return (p - src);
}
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index f6e8b20..86777a8 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -1895,7 +1895,7 @@ Tcl_PkgInitStubsCheck(
{
const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0);
- if (exact && actualVersion) {
+ if ((exact&1) && actualVersion) {
const char *p = version;
int count = 0;
diff --git a/generic/tclProc.c b/generic/tclProc.c
index ef7ce13..8223171 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -907,7 +907,7 @@ TclObjGetFrame(
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
return -1;
}
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 859cbf9..afabdca 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -24,13 +24,10 @@ const TclIntStubs *tclIntStubsPtr = NULL;
const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
/*
- * Use our own isDigit to avoid linking to libc on windows
+ * Use our own ISDIGIT to avoid linking to libc on windows
*/
-static int isDigit(const int c)
-{
- return (c >= '0' && c <= '9');
-}
+#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9)
/*
*----------------------------------------------------------------------
@@ -54,7 +51,8 @@ MODULE_SCOPE const char *
Tcl_InitStubs(
Tcl_Interp *interp,
const char *version,
- int exact)
+ int exact,
+ int magic)
{
Interp *iPtr = (Interp *) interp;
const char *actualVersion = NULL;
@@ -67,8 +65,8 @@ Tcl_InitStubs(
* times. [Bug 615304]
*/
- if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) {
- iPtr->result = "interpreter uses an incompatible stubs mechanism";
+ if (!stubsPtr || (stubsPtr->magic != (((exact&0xff00) >= 0x900) ? magic : TCL_STUB_MAGIC))) {
+ iPtr->result = (char *)"interpreter uses an incompatible stubs mechanism";
iPtr->freeProc = TCL_STATIC;
return NULL;
}
@@ -77,12 +75,12 @@ Tcl_InitStubs(
if (actualVersion == NULL) {
return NULL;
}
- if (exact) {
+ if (exact&1) {
const char *p = version;
int count = 0;
while (*p) {
- count += !isDigit(*p++);
+ count += !ISDIGIT(*p++);
}
if (count == 1) {
const char *q = actualVersion;
@@ -91,7 +89,7 @@ Tcl_InitStubs(
while (*p && (*p == *q)) {
p++; q++;
}
- if (*p || isDigit(*q)) {
+ if (*p || ISDIGIT(*q)) {
/* Construct error message */
stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
return NULL;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index cb1ee21..003338c 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -4917,7 +4917,8 @@ Tcl_UpvarObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad level \"%s\"", TclGetString(levelObj)));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LEVEL", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
+ TclGetString(levelObj), NULL);
return TCL_ERROR;
}
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 691d57a..dac47cf 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -2906,9 +2906,9 @@ ZlibTransformClose(
}
}
} while (e != Z_STREAM_END);
- e = deflateEnd(&cd->outStream);
+ (void) deflateEnd(&cd->outStream);
} else {
- e = inflateEnd(&cd->inStream);
+ (void) inflateEnd(&cd->inStream);
}
/*
@@ -3344,10 +3344,13 @@ ZlibTransformGetOption(
Tcl_DStringAppendElement(dsPtr, "");
}
} else {
- int len;
- const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len);
+ if (cd->compDictObj) {
+ int len;
+ const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len);
- Tcl_DStringAppend(dsPtr, str, len);
+ Tcl_DStringAppend(dsPtr, str, len);
+ }
+ return TCL_OK;
}
}
@@ -3549,7 +3552,6 @@ ZlibStackChannelTransform(
ZlibChannelData *cd = ckalloc(sizeof(ZlibChannelData));
Tcl_Channel chan;
int wbits = 0;
- int e;
if (mode != TCL_ZLIB_STREAM_DEFLATE && mode != TCL_ZLIB_STREAM_INFLATE) {
Tcl_Panic("unknown mode: %d", mode);
@@ -3603,43 +3605,35 @@ ZlibStackChannelTransform(
*/
if (mode == TCL_ZLIB_STREAM_INFLATE) {
- e = inflateInit2(&cd->inStream, wbits);
- if (e != Z_OK) {
+ if (inflateInit2(&cd->inStream, wbits) != Z_OK) {
goto error;
}
cd->inAllocated = DEFAULT_BUFFER_SIZE;
cd->inBuffer = ckalloc(cd->inAllocated);
if (cd->flags & IN_HEADER) {
- e = inflateGetHeader(&cd->inStream, &cd->inHeader.header);
- if (e != Z_OK) {
+ if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) {
goto error;
}
}
if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) {
- e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
- if (e != Z_OK) {
+ if (SetInflateDictionary(&cd->inStream, cd->compDictObj) != Z_OK) {
goto error;
}
- TclDecrRefCount(cd->compDictObj);
- cd->compDictObj = NULL;
}
} else {
- e = deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
- MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
- if (e != Z_OK) {
+ if (deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
+ MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY) != Z_OK) {
goto error;
}
cd->outAllocated = DEFAULT_BUFFER_SIZE;
cd->outBuffer = ckalloc(cd->outAllocated);
if (cd->flags & OUT_HEADER) {
- e = deflateSetHeader(&cd->outStream, &cd->outHeader.header);
- if (e != Z_OK) {
+ if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) {
goto error;
}
}
if (cd->compDictObj) {
- e = SetDeflateDictionary(&cd->outStream, cd->compDictObj);
- if (e != Z_OK) {
+ if (SetDeflateDictionary(&cd->outStream, cd->compDictObj) != Z_OK) {
goto error;
}
}
diff --git a/tests/dict.test b/tests/dict.test
index d5406d0..a6b0cb4 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -2048,6 +2048,13 @@ test dict-24.25 {dict map with huge dict (compiled)} {
}} 100000
} 166666666600000
+test dict-25.1 {compiled dict update with low-refcount values [Bug d553228d9f]} {
+ # Test crashes on failure
+ apply {{} {
+ lassign {} item
+ dict update item item item two two {}
+ }}
+} {}
# cleanup
::tcltest::cleanupTests
diff --git a/tests/zlib.test b/tests/zlib.test
index 968469d..c9e5f10 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -401,6 +401,26 @@ test zlib-8.16 {Bug 3603553: buffer transfer with large writes} -setup {
} -cleanup {
removeFile $file
} -result 57647
+test zlib-8.17 {Bug dd260aaf: fconfigure} -setup {
+ lassign [chan pipe] inSide outSide
+} -constraints zlib -body {
+ zlib push inflate $inSide
+ zlib push deflate $outSide
+ list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary]
+} -cleanup {
+ catch {close $inSide}
+ catch {close $outSide}
+} -result {{} {}}
+test zlib-8.18 {Bug dd260aaf: fconfigure} -setup {
+ lassign [chan pipe] inSide outSide
+} -constraints zlib -body {
+ zlib push inflate $inSide -dictionary "one two"
+ zlib push deflate $outSide -dictionary "one two"
+ list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary]
+} -cleanup {
+ catch {close $inSide}
+ catch {close $outSide}
+} -result {{one two} {one two}}
test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
set sfile [makeFile {} testsrc.gz]
diff --git a/unix/installManPage b/unix/installManPage
index 4d615bf..1f1cbde 100755
--- a/unix/installManPage
+++ b/unix/installManPage
@@ -106,7 +106,7 @@ for Target in $Names; do
First=$Target
sed -e "/man\.macros/r $SrcDir/man.macros" -e "/man\.macros/d" \
$ManPage > $Dir/$First
- chmod 444 $Dir/$First
+ chmod 644 $Dir/$First
$Gzip $Dir/$First
else
ln $SymOrLoc$First$Gz $Dir/$Target$Gz
generated by cgit v0.12 at 2024-08-21 08:41:31 (GMT)