From 330add62d15d66049d37d4e23a769b78074d15ab Mon Sep 17 00:00:00 2001 From: andreas_kupries Date: Fri, 23 May 2008 21:00:42 +0000 Subject: * win/tclWinChan.c (FileWideSeekProc): Accepted a patch by Alexandre Ferrieux to fix the [Bug 1965787]. 'tell' now works for locations > 2 GB as well instead of going negative. * generic/tclIO.c (Tcl_SetChannelBufferSize): Accepted a patch by * tests/io.test: Alexandre Ferrieux * tests/chanio.test: to fix the [Bug 1969953]. Buffersize outside of the supported range are now clipped to nearest boundary instead of ignored. --- ChangeLog | 13 +++++++++++++ generic/tclIO.c | 13 ++++++++----- generic/tclVar.c | 15 ++++++++++++--- tests/chanio.test | 12 ++++++------ tests/io.test | 12 ++++++------ tools/genStubs.tcl | 5 ++++- unix/Makefile.in | 8 ++++---- win/Makefile.in | 7 ++++--- win/tclWinChan.c | 4 ++-- 9 files changed, 59 insertions(+), 30 deletions(-) diff --git a/ChangeLog b/ChangeLog index 82b5e4e..b295620 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2008-05-23 Andreas Kupries + + * win/tclWinChan.c (FileWideSeekProc): Accepted a patch by + Alexandre Ferrieux to fix the + [Bug 1965787]. 'tell' now works for locations > 2 GB as well + instead of going negative. + + * generic/tclIO.c (Tcl_SetChannelBufferSize): Accepted a patch by + * tests/io.test: Alexandre Ferrieux + * tests/chanio.test: to fix the [Bug 1969953]. Buffersize outside + of the supported range are now clipped to nearest boundary instead + of ignored. + 2008-05-22 Don Porter * generic/tclNamesp.c (Tcl_LogCommandInfo): Restored ability to diff --git a/generic/tclIO.c b/generic/tclIO.c index 1d917ba..08d73ec 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIO.c,v 1.142 2008/04/15 18:34:47 andreas_kupries Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.143 2008/05/23 21:00:44 andreas_kupries Exp $ */ #include "tclInt.h" @@ -224,6 +224,8 @@ static Tcl_ObjType tclChannelType = { #define BUSY_STATE(st,fl) \ ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \ (((st)->csPtrW) && ((fl) & TCL_WRITABLE))) + +#define MAX_CHANNEL_BUFFER_SIZE (1024*1024) /* *--------------------------------------------------------------------------- @@ -6937,12 +6939,13 @@ Tcl_SetChannelBufferSize( ChannelState *statePtr; /* State of real channel structure. */ /* - * If the buffer size is smaller than 1 byte or larger than one MByte, do - * not accept the requested size and leave the current buffer size. + * Clip the buffer size to force it into the [1,1M] range */ - if (sz < 1 || sz > 1024*1024) { - return; + if (sz < 1) { + sz = 1; + } else if (sz > MAX_CHANNEL_BUFFER_SIZE) { + sz = MAX_CHANNEL_BUFFER_SIZE; } statePtr = ((Channel *) chan)->state; diff --git a/generic/tclVar.c b/generic/tclVar.c index 3bcc527..a88f15c 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.160 2008/03/11 17:23:56 msofer Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.161 2008/05/23 21:00:45 andreas_kupries Exp $ */ #include "tclInt.h" @@ -67,10 +67,19 @@ VarHashCreateVar( #define VarHashFindVar(tablePtr, key) \ VarHashCreateVar((tablePtr), (key), NULL) - +#ifdef _AIX +/* Work around AIX cc problem causing crash in TclDeleteVars. Possible + * optimizer bug. Do _NOT_ inline this function, this re-activates the + * problem. + */ +static void +VarHashInvalidateEntry(Var* varPtr) { + varPtr->flags |= VAR_DEAD_HASH; +} +#else #define VarHashInvalidateEntry(varPtr) \ ((varPtr)->flags |= VAR_DEAD_HASH) - +#endif #define VarHashDeleteEntry(varPtr) \ Tcl_DeleteHashEntry(&(((VarInHash *) varPtr)->entry)) diff --git a/tests/chanio.test b/tests/chanio.test index 6e8fb44..6e44c38 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: chanio.test,v 1.12 2008/04/23 15:44:37 dkf Exp $ +# RCS: @(#) $Id: chanio.test,v 1.13 2008/05/23 21:00:45 andreas_kupries Exp $ if {[catch {package require tcltest 2}]} { chan puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -4863,7 +4863,7 @@ test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} { lappend l [chan configure $f -buffersize] chan close $f set l -} {4096 10000 1 1 1 100000 100000} +} {4096 10000 1 1 1 100000 1048576} test chan-io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} { # This test crashes the interp if Bug #427196 is not fixed @@ -5024,22 +5024,22 @@ test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} { chan close $f1 set x } {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1} -test chan-io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { +test chan-io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} { file delete $path(test1) set f [open $path(test1) w] chan configure $f -buffersize -10 set x [chan configure $f -buffersize] chan close $f set x -} 4096 -test chan-io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} { +} 1 +test chan-io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} { file delete $path(test1) set f [open $path(test1) w] chan configure $f -buffersize 10000000 set x [chan configure $f -buffersize] chan close $f set x -} 4096 +} 1048576 test chan-io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { file delete $path(test1) set f [open $path(test1) w] diff --git a/tests/io.test b/tests/io.test index e03fa8a..10115c1 100644 --- a/tests/io.test +++ b/tests/io.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: io.test,v 1.88 2008/04/15 18:34:48 andreas_kupries Exp $ +# RCS: @(#) $Id: io.test,v 1.89 2008/05/23 21:00:45 andreas_kupries Exp $ if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -4858,7 +4858,7 @@ test io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} { lappend l [fconfigure $f -buffersize] close $f set l -} {4096 10000 1 1 1 100000 100000} +} {4096 10000 1 1 1 100000 1048576} test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} { # This test crashes the interp if Bug #427196 is not fixed @@ -5019,22 +5019,22 @@ test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} { close $f1 set x } {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1} -test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { +test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -buffersize -10 set x [fconfigure $f -buffersize] close $f set x -} 4096 -test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} { +} 1 +test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -buffersize 10000000 set x [fconfigure $f -buffersize] close $f set x -} 4096 +} 1048576 test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { file delete $path(test1) set f [open $path(test1) w] diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index ec70115..69f4a84 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: genStubs.tcl,v 1.26 2008/04/16 14:49:29 das Exp $ +# RCS: @(#) $Id: genStubs.tcl,v 1.27 2008/05/23 21:00:46 andreas_kupries Exp $ package require Tcl 8.4 @@ -208,6 +208,9 @@ proc genStubs::rewriteFile {file text} { set in [open ${file} r] set out [open ${file}.new w] + # Hardwire the genstubs output to Unix eol. + fconfigure $out -translation lf + while {![eof $in]} { set line [gets $in] if {[string match "*!BEGIN!*" $line]} { diff --git a/unix/Makefile.in b/unix/Makefile.in index bfeccb7..c930e11 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -4,7 +4,7 @@ # "./configure", which is a configuration script generated by the "autoconf" # program (constructs like "@foo@" will get replaced in the actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.231 2008/04/15 10:10:43 das Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.232 2008/05/23 21:00:46 andreas_kupries Exp $ VERSION = @TCL_VERSION@ MAJOR_VERSION = @TCL_MAJOR_VERSION@ @@ -875,8 +875,8 @@ install-private-headers: libraries $(INSTALL_DATA) tclConfig.h "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ fi; -Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in - $(SHELL) config.status +#Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in +# $(SHELL) config.status #tclConfig.h: $(UNIX_DIR)/tclConfig.h.in # $(SHELL) config.status @@ -1843,4 +1843,4 @@ package-generate: pkgtrans -s . $(PACKAGE).`arch` $(PACKAGE) rm -rf $(PACKAGE) -# DO NOT DELETE THIS LINE -- make depend depends on it. +# DO NOT DELETE THIS LINE -- make depend depends on it. \ No newline at end of file diff --git a/win/Makefile.in b/win/Makefile.in index 6bd5e39..58a3505 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -4,7 +4,7 @@ # "./configure", which is a configuration script generated by the "autoconf" # program (constructs like "@foo@" will get replaced in the actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.126 2008/04/09 21:44:58 dkf Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.127 2008/05/23 21:00:47 andreas_kupries Exp $ VERSION = @TCL_VERSION@ @@ -716,8 +716,8 @@ gdb: binaries depend: -Makefile: $(SRC_DIR)/Makefile.in - ./config.status +#Makefile: $(SRC_DIR)/Makefile.in +# ./config.status cleanhelp: $(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe @@ -763,3 +763,4 @@ html-tcl: $(TCLSH) $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tcl" html-tk: $(TCLSH) $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tk" + diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 98a529a..5d2a774 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinChan.c,v 1.50 2008/04/27 22:21:36 dkf Exp $ + * RCS: @(#) $Id: tclWinChan.c,v 1.51 2008/05/23 21:00:47 andreas_kupries Exp $ */ #include "tclWinInt.h" @@ -575,7 +575,7 @@ FileWideSeekProc( return -1; } } - return (Tcl_LongAsWide(newPos) | (Tcl_LongAsWide(newPosHigh) << 32)); + return (((Tcl_WideInt)((unsigned)newPos)) | (Tcl_LongAsWide(newPosHigh) << 32)); } /* -- cgit v0.12