From cb9a441bb90bab156fe3bcd024cb2490dbd45fb3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 26 Jun 2016 09:00:06 +0000 Subject: (cherry-pick) [c30087b04f] Install man pages with permissions 644 instead of 444. --- unix/installManPage | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 -- cgit v0.12 From 9c058fa5d4a7dd8f3260f31523dea954bb6f2f9f Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 27 Jun 2016 13:44:40 +0000 Subject: [c3d956be5b] Clearer text about positioning of optional arguments. --- doc/proc.n | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 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 -- cgit v0.12 From 7a41668df0cca48f94ed89f97164bbb1ddd85e32 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 27 Jun 2016 13:46:15 +0000 Subject: [c3d956be5b] Clearer text about positioning of optional arguments. --- doc/proc.n | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 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 -- cgit v0.12 From 16dc4253187f0ef49c09688cd3a2085120328302 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 27 Jun 2016 14:27:43 +0000 Subject: [dd260aaf72] Allow the -dictionary option to be read from a pushed transform. --- doc/zlib.n | 18 ++++++++++++------ generic/tclZlib.c | 36 +++++++++++++++--------------------- tests/zlib.test | 20 ++++++++++++++++++++ 3 files changed, 47 insertions(+), 27 deletions(-) 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/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/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] -- cgit v0.12 From bf285438a2b30acf74d19b010139b66f5e2fb528 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 27 Jun 2016 15:16:04 +0000 Subject: Streamline comment parsing. --- generic/tclParse.c | 67 +++++++++++++++++++++++++++--------------------------- 1 file changed, 33 insertions(+), 34 deletions(-) diff --git a/generic/tclParse.c b/generic/tclParse.c index 95abc45..4974c87 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); /* *---------------------------------------------------------------------- @@ -733,23 +735,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 +1032,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 +1045,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); } -- cgit v0.12 From cc2f6f6a7d3968e4411d45a4d5ee62b390bb3f4e Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 27 Jun 2016 19:01:34 +0000 Subject: Stop parsing white space where there cannot be any. --- generic/tclParse.c | 69 ++++++++++++++++++++++-------------------------------- 1 file changed, 28 insertions(+), 41 deletions(-) diff --git a/generic/tclParse.c b/generic/tclParse.c index 4974c87..3372318 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -294,12 +294,18 @@ Tcl_ParseCommand( } } + /* Jump to where we check for command termination */ + + parsePtr->commandStart = src; + type = CHAR_TYPE(*src); + scanned = 1; + goto start; + /* * The following loop parses the words of the command, one word in each * iteration through the loop. */ - parsePtr->commandStart = src; while (1) { int expandWord = 0; @@ -312,23 +318,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++; @@ -555,12 +544,10 @@ Tcl_ParseCommand( */ scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type); - if (scanned) { - src += scanned; - numBytes -= scanned; - continue; - } + src += scanned; + numBytes -= scanned; + start: if (numBytes == 0) { parsePtr->term = src; break; @@ -570,30 +557,30 @@ Tcl_ParseCommand( 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)); + 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->errorType = TCL_PARSE_BRACE_EXTRA; + parsePtr->term = src; + error: + Tcl_FreeParse(parsePtr); + parsePtr->commandSize = parsePtr->end - parsePtr->commandStart; + return TCL_ERROR; } - parsePtr->term = src; - goto error; } parsePtr->commandSize = src - parsePtr->commandStart; return TCL_OK; - - error: - Tcl_FreeParse(parsePtr); - parsePtr->commandSize = parsePtr->end - parsePtr->commandStart; - return TCL_ERROR; } /* -- cgit v0.12