From 707993b1dd4f01322cdbea334c71a1202373fa9b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 4 Jan 2017 15:16:31 +0000 Subject: Fix safe.tcl test-cases: "source -nopkg" is not necessary here: "source" is an alias for "::safe::AliasSource", which doesn't use "source" --- library/init.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/init.tcl b/library/init.tcl index 65a19aa..e3d4ef0 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -486,7 +486,7 @@ proc auto_load_index {} { set dir [lindex $auto_path $i] set f "" if {$issafe} { - catch {source -nopkg [file join $dir tclIndex]} + catch {source [file join $dir tclIndex]} } elseif {[catch {set f [open [file join $dir tclIndex]]}]} { continue } else { -- cgit v0.12 From 9f5fab9296c69ae125f5d288a5cca0d1dc3321ec Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 4 Jan 2017 16:23:23 +0000 Subject: In stead of "source -nopkg" use a ::tcl::Pkg::source utility function. --- generic/tclCmdMZ.c | 28 ++---------- library/init.tcl | 24 ++++++++++- library/package.tcl | 2 +- library/tclIndex | 120 +++++++++++++++++++++++++++++----------------------- 4 files changed, 92 insertions(+), 82 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index fbc9d8f..23e6bd1 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -989,11 +989,8 @@ TclNRSourceObjCmd( { const char *encodingName = NULL; Tcl_Obj *fileName; - int result; - void **pkgFiles = NULL; - void *names = NULL; - if (objc < 2 || objc > 4) { + if (objc != 2 && objc !=4) { Tcl_WrongNumArgs(interp, 1, objv, "?-encoding name? fileName"); return TCL_ERROR; } @@ -1011,28 +1008,9 @@ TclNRSourceObjCmd( return TCL_ERROR; } encodingName = TclGetString(objv[2]); - } else if (objc == 3) { - static const char *const nopkgoptions[] = { - "-nopkg", NULL - }; - int index; - - if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], nopkgoptions, - "option", TCL_EXACT, &index)) { - return TCL_ERROR; - } - pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL); - /* Make sure that during the following TclNREvalFile no filenames - * are recorded for inclusion in the "package files" command */ - names = *pkgFiles; - *pkgFiles = NULL; - } - result = TclNREvalFile(interp, fileName, encodingName); - if (pkgFiles) { - /* restore "tclPkgFiles" assocdata to how it was. */ - *pkgFiles = names; } - return result; + + return TclNREvalFile(interp, fileName, encodingName); } /* diff --git a/library/init.tcl b/library/init.tcl index e3d4ef0..9101e35 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -46,8 +46,6 @@ if {![info exists auto_path]} { } } -source [file join $::tcl_library auto.tcl] - namespace eval tcl { variable Dir foreach Dir [list $::tcl_library [file dirname $::tcl_library]] { @@ -115,6 +113,8 @@ namespace eval tcl { } } +namespace eval tcl::Pkg {} + # Windows specific end of initialization if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { @@ -460,6 +460,26 @@ proc auto_load {cmd {namespace {}}} { return 0 } +# ::tcl::Pkg::source -- +# This procedure provides an alternative "source" command, which doesn't +# register the file for the "package files" command. Safe interpreters +# don't have to do anything special. +# +# Arguments: +# filename + +proc ::tcl::Pkg::source {filename} { + if {[interp issafe]} { + uplevel 1 [list ::source $filename] + } else { + set f [open $filename] + fconfigure $f -eofchar \032 + set contents [read $f] + close $f + uplevel 1 [list eval $contents] + } +} + # auto_load_index -- # Loads the contents of tclIndex files on the auto_path directory # list. This is usually invoked within auto_load to load the index diff --git a/library/package.tcl b/library/package.tcl index cb1bea6..1cb2d3d 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -488,7 +488,7 @@ proc tclPkgUnknown {name args} { set dir [file dirname $file] if {![info exists procdDirs($dir)]} { try { - source -nopkg $file + ::tcl::Pkg::source $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue diff --git a/library/tclIndex b/library/tclIndex index 09aba56..87a2814 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -7,57 +7,69 @@ # element name is the name of a command and the value is # a script that loads the command. -set auto_index(history) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistClear) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistInfo) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]] -set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]] -set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]] -set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]] -set auto_index(::tcl::MacOSXPkgUnknown) [list source [file join $dir package.tcl]] -set auto_index(::pkg::create) [list source [file join $dir package.tcl]] -set auto_index(parray) [list source [file join $dir parray.tcl]] -set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]] -set auto_index(::safe::CheckInterp) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpCreate) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpSetConfig) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpInit) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]] -set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]] -set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]] -set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::Log) [list source [file join $dir safe.tcl]] -set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasGlob) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]] -set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::DirInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasEncoding) [list source [file join $dir safe.tcl]] -set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]] -set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]] -set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]] -set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]] -set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]] -set auto_index(::tcl::tm::add) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::remove) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::list) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::Defaults) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::UnknownHandler) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::roots) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::path) [list source [file join $dir tm.tcl]] +set auto_index(auto_reset) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(tcl_findLibrary) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(auto_mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(auto_mkindex_old) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::init) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::cleanup) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::hook) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::slavehook) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::command) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::commandInit) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::fullname) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(history) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistAdd) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistKeep) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistClear) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistInfo) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistRedo) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistIndex) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistEvent) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistChange) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(pkg_mkIndex) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(tclPkgSetup) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(tclPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(::tcl::MacOSXPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(::pkg::create) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(parray) [list ::tcl::Pkg::source [file join $dir parray.tcl]] +set auto_index(::safe::InterpStatics) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpNested) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpInit) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::CheckInterp) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpConfigure) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpSetConfig) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpFindInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpAddToAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpInit) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AddSubDirs) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpDelete) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::setLogCmd) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::SyncAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::PathToken) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::TranslatePath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::Log) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::CheckFileName) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasGlob) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasSource) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasLoad) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::FileInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::DirInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::Subset) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasSubset) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasEncoding) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(tcl_wordBreakAfter) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_wordBreakBefore) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_endOfWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_startOfNextWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_startOfPreviousWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(::tcl::tm::add) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::remove) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::list) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::Defaults) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::UnknownHandler) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::roots) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::path) [list ::tcl::Pkg::source [file join $dir tm.tcl]] -- cgit v0.12 From 7660a167e1a0bfce591e4b2a7b6b7043e72925af Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 5 Jan 2017 13:09:26 +0000 Subject: One more ::tcl::Pkg::source, for the Mac --- library/package.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/package.tcl b/library/package.tcl index 5257cd6..c72fbfb 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -590,7 +590,7 @@ proc tcl::MacOSXPkgUnknown {original name args} { set dir [file dirname $file] if {![info exists procdDirs($dir)]} { try { - source $file + ::tcl::Pkg::source $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue -- cgit v0.12 From f39edc377395db21fa57a8bf93bdbf367b3a5254 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 11 Jan 2017 16:23:18 +0000 Subject: Use more Tcl_AppendResult(), in order to prevent the use of a (char *) type case. --- generic/tclTest.c | 56 +++++++++++++++++++++++++++---------------------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 85e4a29..faecbc6 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -90,7 +90,7 @@ static Tcl_Trace cmdTrace; * TestdelCmd: */ -typedef struct DelCmd { +typedef struct { Tcl_Interp *interp; /* Interpreter in which command exists. */ char *deleteCmd; /* Script to execute when command is deleted. * Malloc'ed. */ @@ -101,7 +101,7 @@ typedef struct DelCmd { * command. */ -typedef struct TclEncoding { +typedef struct { Tcl_Interp *interp; char *toUtfCmd; char *fromUtfCmd; @@ -124,7 +124,7 @@ static int exitMainLoop = 0; * Event structure used in testing the event queue management procedures. */ -typedef struct TestEvent { +typedef struct { Tcl_Event header; /* Header common to all events */ Tcl_Interp *interp; /* Interpreter that will handle the event */ Tcl_Obj *command; /* Command to evaluate when the event occurs */ @@ -823,7 +823,7 @@ TestasyncCmd( if (argc < 2) { wrongNumArgs: - Tcl_SetResult(interp, (char *)"wrong # args", TCL_STATIC); + Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { @@ -913,7 +913,7 @@ TestasyncCmd( if (Tcl_CreateThread(&threadID, AsyncThreadProc, INT2PTR(id), TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) { - Tcl_SetResult(interp, (char *)"can't create thread", TCL_STATIC); + Tcl_AppendResult(interp, "can't create thread", NULL); Tcl_MutexUnlock(&asyncTestMutex); return TCL_ERROR; } @@ -1060,7 +1060,7 @@ TestcmdinfoCmd( Tcl_DStringResult(interp, &delString); } else if (strcmp(argv[1], "get") == 0) { if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) { - Tcl_SetResult(interp, (char *)"??", TCL_STATIC); + Tcl_AppendResult(interp, "??", NULL); return TCL_OK; } if (info.proc == CmdProc1) { @@ -1187,7 +1187,7 @@ TestcmdtokenCmd( token = Tcl_CreateCommand(interp, argv[2], CmdProc1, (ClientData) "original", NULL); sprintf(buf, "%p", (void *)token); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_AppendResult(interp, buf, NULL); } else if (strcmp(argv[1], "name") == 0) { Tcl_Obj *objPtr; @@ -1293,7 +1293,7 @@ TestcmdtraceCmd( result = Tcl_EvalEx(interp, argv[2], -1, 0); Tcl_DeleteTrace(interp, cmdTrace); if (!deleteCalled) { - Tcl_SetResult(interp, (char *)"Delete wasn't called", TCL_STATIC); + Tcl_AppendResult(interp, "Delete wasn't called", NULL); return TCL_ERROR; } else { return result; @@ -1593,7 +1593,7 @@ TestdelCmd( Tcl_Interp *slave; if (argc != 4) { - Tcl_SetResult(interp, (char *)"wrong # args", TCL_STATIC); + Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } @@ -1798,7 +1798,7 @@ TestdstringCmd( if (argc < 2) { wrongNumArgs: - Tcl_SetResult(interp, (char *)"wrong # args", TCL_STATIC); + Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } if (strcmp(argv[1], "append") == 0) { @@ -1834,9 +1834,9 @@ TestdstringCmd( goto wrongNumArgs; } if (strcmp(argv[2], "staticsmall") == 0) { - Tcl_SetResult(interp, (char *)"short", TCL_STATIC); + Tcl_AppendResult(interp, "short", NULL); } else if (strcmp(argv[2], "staticlarge") == 0) { - Tcl_SetResult(interp, (char *)"first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC); + Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL); } else if (strcmp(argv[2], "free") == 0) { char *s = ckalloc(100); strcpy(s, "This is a malloc-ed string"); @@ -1996,7 +1996,7 @@ EncodingToUtfProc( TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; - Tcl_EvalEx(encodingPtr->interp,encodingPtr->toUtfCmd,-1,TCL_EVAL_GLOBAL); + Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, -1, TCL_EVAL_GLOBAL); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { @@ -2028,7 +2028,7 @@ EncodingFromUtfProc( TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; - Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd,-1,TCL_EVAL_GLOBAL); + Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, -1, TCL_EVAL_GLOBAL); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { @@ -2436,7 +2436,7 @@ TestexprlongCmd( " expression\"", NULL); return TCL_ERROR; } - Tcl_SetResult(interp, (char *)"This is a result", TCL_STATIC); + Tcl_AppendResult(interp, "This is a result", NULL); result = Tcl_ExprLong(interp, argv[1], &exprResult); if (result != TCL_OK) { return result; @@ -2478,7 +2478,7 @@ TestexprlongobjCmd( Tcl_WrongNumArgs(interp, 1, objv, "expression"); return TCL_ERROR; } - Tcl_SetResult(interp, (char *)"This is a result", TCL_STATIC); + Tcl_AppendResult(interp, "This is a result", NULL); result = Tcl_ExprLongObj(interp, objv[1], &exprResult); if (result != TCL_OK) { return result; @@ -2521,7 +2521,7 @@ TestexprdoubleCmd( " expression\"", NULL); return TCL_ERROR; } - Tcl_SetResult(interp, (char *)"This is a result", TCL_STATIC); + Tcl_AppendResult(interp, "This is a result", NULL); result = Tcl_ExprDouble(interp, argv[1], &exprResult); if (result != TCL_OK) { return result; @@ -2564,7 +2564,7 @@ TestexprdoubleobjCmd( Tcl_WrongNumArgs(interp, 1, objv, "expression"); return TCL_ERROR; } - Tcl_SetResult(interp, (char *)"This is a result", TCL_STATIC); + Tcl_AppendResult(interp, "This is a result", NULL); result = Tcl_ExprDoubleObj(interp, objv[1], &exprResult); if (result != TCL_OK) { return result; @@ -4486,7 +4486,7 @@ TestseterrorcodeCmd( const char **argv) /* Argument strings. */ { if (argc > 6) { - Tcl_SetResult(interp, (char *)"too many args", TCL_STATIC); + Tcl_AppendResult(interp, "too many args", NULL); return TCL_ERROR; } switch (argc) { @@ -5090,7 +5090,7 @@ TestsetCmd( const char *value; if (argc == 2) { - Tcl_SetResult(interp, (char *)"before get", TCL_STATIC); + Tcl_AppendResult(interp, "before get", NULL); value = Tcl_GetVar2(interp, argv[1], NULL, flags); if (value == NULL) { return TCL_ERROR; @@ -5098,7 +5098,7 @@ TestsetCmd( Tcl_AppendElement(interp, value); return TCL_OK; } else if (argc == 3) { - Tcl_SetResult(interp, (char *)"before set", TCL_STATIC); + Tcl_AppendResult(interp, "before set", NULL); value = Tcl_SetVar2(interp, argv[1], NULL, argv[2], flags); if (value == NULL) { return TCL_ERROR; @@ -5122,7 +5122,7 @@ Testset2Cmd( const char *value; if (argc == 3) { - Tcl_SetResult(interp, (char *)"before get", TCL_STATIC); + Tcl_AppendResult(interp, "before get", NULL); value = Tcl_GetVar2(interp, argv[1], argv[2], flags); if (value == NULL) { return TCL_ERROR; @@ -5130,7 +5130,7 @@ Testset2Cmd( Tcl_AppendElement(interp, value); return TCL_OK; } else if (argc == 4) { - Tcl_SetResult(interp, (char *)"before set", TCL_STATIC); + Tcl_AppendResult(interp, "before set", NULL); value = Tcl_SetVar2(interp, argv[1], argv[2], argv[3], flags); if (value == NULL) { return TCL_ERROR; @@ -5200,7 +5200,7 @@ TestsaveresultCmd( objPtr = NULL; /* Lint. */ switch ((enum options) index) { case RESULT_SMALL: - Tcl_SetResult(interp, (char *)"small result", TCL_VOLATILE); + Tcl_AppendResult(interp, "small result", NULL); break; case RESULT_APPEND: Tcl_AppendResult(interp, "append result", NULL); @@ -5310,7 +5310,7 @@ TestmainthreadCmd( Tcl_SetObjResult(interp, idObj); return TCL_OK; } else { - Tcl_SetResult(interp, (char *)"wrong # args", TCL_STATIC); + Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } } @@ -6111,7 +6111,7 @@ TestWrongNumArgsObjCmd( * Don't use Tcl_WrongNumArgs here, as that is the function * we want to test! */ - Tcl_SetResult(interp, (char *)"insufficient arguments", TCL_STATIC); + Tcl_AppendResult(interp, "insufficient arguments", NULL); return TCL_ERROR; } @@ -6128,7 +6128,7 @@ TestWrongNumArgsObjCmd( /* * Asked for more arguments than were given. */ - Tcl_SetResult(interp, (char *)"insufficient arguments", TCL_STATIC); + Tcl_AppendResult(interp, "insufficient arguments", NULL); return TCL_ERROR; } @@ -6905,7 +6905,7 @@ TestgetintCmd( const char **argv) { if (argc < 2) { - Tcl_SetResult(interp, (char *)"wrong # args", TCL_STATIC); + Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } else { int val, i, total=0; -- cgit v0.12 From 16bf696cda8c2d64b7262c508de606277c018572 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 12 Jan 2017 08:44:56 +0000 Subject: Allows to compile direct from Visual Studio IDE (prevents throwing error "LNK1561: entry point must be defined" by testing linker) --- win/rules.vc | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/win/rules.vc b/win/rules.vc index aa4ed1e..ecdd28f 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -188,9 +188,14 @@ COMPILERFLAGS = $(COMPILERFLAGS) -QIA64_Bx !endif !endif +# Prevents "LNK1561: entry point must be defined" error compiling from VS-IDE: +!ifndef LINKER_TESTFLAGS +LINKER_TESTFLAGS = -entry:_DllMainCRTStartup@12 +!endif + !if "$(MACHINE)" == "IX86" ### test for -align:4096, when align:512 will do. -!if [nmakehlp -l -opt:nowin98] +!if [nmakehlp -l -opt:nowin98 $(LINKER_TESTFLAGS)] !message *** Linker has 'Win98 alignment problem' ALIGN98_HACK = 1 !else @@ -203,7 +208,7 @@ ALIGN98_HACK = 0 LINKERFLAGS = -!if [nmakehlp -l -ltcg] +!if [nmakehlp -l -ltcg $(LINKER_TESTFLAGS)] LINKERFLAGS =-ltcg !endif @@ -412,7 +417,7 @@ TCL_NO_DEPRECATED = 0 !if [nmakehlp -f $(CHECKS) "fullwarn"] !message *** Doing full warnings check WARNINGS = -W4 -!if [nmakehlp -l -warn:3] +!if [nmakehlp -l -warn:3 $(LINKER_TESTFLAGS)] LINKERFLAGS = $(LINKERFLAGS) -warn:3 !endif !else @@ -425,7 +430,7 @@ WARNINGS = $(WARNINGS) -Wp64 !endif !if $(PGO) > 1 -!if [nmakehlp -l -ltcg:pgoptimize] +!if [nmakehlp -l -ltcg:pgoptimize $(LINKER_TESTFLAGS)] LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize !else MSG=^ @@ -433,7 +438,7 @@ This compiler does not support profile guided optimization. !error $(MSG) !endif !elseif $(PGO) > 0 -!if [nmakehlp -l -ltcg:pginstrument] +!if [nmakehlp -l -ltcg:pginstrument $(LINKER_TESTFLAGS)] LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument !else MSG=^ -- cgit v0.12 From 141e6231e557acca18c4011cb10ebc546e77df8a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 12 Jan 2017 10:31:46 +0000 Subject: Fix version number in tcl.dsp (thanks to Arjen Markus for noticing this) --- win/tcl.dsp | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/win/tcl.dsp b/win/tcl.dsp index 96d5893..6f17cdb 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -36,7 +36,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Release\tcl_Dynamic" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=none MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Release\tclsh85.exe" +# PROP BASE Target_File "Release\tclsh86.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 @@ -45,7 +45,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Release\tcl_Dynamic" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads MSVCDIR=IDE" # PROP Rebuild_Opt "clean release" -# PROP Target_File "Release\tclsh85t.exe" +# PROP Target_File "Release\tclsh86t.exe" # PROP Bsc_Name "" # PROP Target_Dir "" @@ -57,7 +57,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Debug\tcl_Dynamic" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Debug\tclsh85g.exe" +# PROP BASE Target_File "Debug\tclsh86g.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 @@ -66,7 +66,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Debug\tcl_Dynamic" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads,symbols MSVCDIR=IDE" # PROP Rebuild_Opt "clean release" -# PROP Target_File "Debug\tclsh85tg.exe" +# PROP Target_File "Debug\tclsh86tg.exe" # PROP Bsc_Name "" # PROP Target_Dir "" @@ -78,7 +78,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Debug\tcl_Static" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Debug\tclsh85sg.exe" +# PROP BASE Target_File "Debug\tclsh86sg.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 @@ -87,7 +87,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Debug\tcl_Static" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE" # PROP Rebuild_Opt "-a" -# PROP Target_File "Debug\tclsh85sg.exe" +# PROP Target_File "Debug\tclsh86sg.exe" # PROP Bsc_Name "" # PROP Target_Dir "" @@ -99,7 +99,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Release\tcl_Static" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Release\tclsh85s.exe" +# PROP BASE Target_File "Release\tclsh86s.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 @@ -108,7 +108,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Release\tcl_Static" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE" # PROP Rebuild_Opt "-a" -# PROP Target_File "Release\tclsh85s.exe" +# PROP Target_File "Release\tclsh86s.exe" # PROP Bsc_Name "" # PROP Target_Dir "" -- cgit v0.12 From 251f7dacec6aa6bcb69903b495307f73449d2bff Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 12 Jan 2017 18:37:50 +0000 Subject: Fixes nmakehlp: allows more as one option by -l, to provide mandatory linker parameters (e. g. "LNK1561: entry point must be defined"); Additionally recognizes an new linker code LNK4224 for "no longer supported; ignored". --- win/nmakehlp.c | 24 ++++++++++++++++-------- win/rules.vc | 2 +- 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 84cf75c..22b7b06 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -43,7 +43,7 @@ /* protos */ static int CheckForCompilerFeature(const char *option); -static int CheckForLinkerFeature(const char *option); +static int CheckForLinkerFeature(const char **options, int count); static int IsIn(const char *string, const char *substring); static int SubstituteFile(const char *substs, const char *filename); static int QualifyPath(const char *path); @@ -102,16 +102,16 @@ main( } return CheckForCompilerFeature(argv[2]); case 'l': - if (argc != 3) { + if (argc < 3) { chars = snprintf(msg, sizeof(msg) - 1, - "usage: %s -l \n" + "usage: %s -l ? ...?\n" "Tests for whether link.exe supports an option\n" "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } - return CheckForLinkerFeature(argv[2]); + return CheckForLinkerFeature(&argv[2], argc-2); case 'f': if (argc == 2) { chars = snprintf(msg, sizeof(msg) - 1, @@ -313,7 +313,8 @@ CheckForCompilerFeature( static int CheckForLinkerFeature( - const char *option) + const char **options, + int count) { STARTUPINFO si; PROCESS_INFORMATION pi; @@ -322,7 +323,8 @@ CheckForLinkerFeature( char msg[300]; BOOL ok; HANDLE hProcess, h, pipeThreads[2]; - char cmdline[100]; + int i; + char cmdline[255]; hProcess = GetCurrentProcess(); @@ -368,7 +370,11 @@ CheckForLinkerFeature( * Append our option for testing. */ - lstrcat(cmdline, option); + for (i = 0; i < count; i++) { + lstrcat(cmdline, " \""); + lstrcat(cmdline, options[i]); + lstrcat(cmdline, "\""); + } ok = CreateProcess( NULL, /* Module name. */ @@ -433,7 +439,9 @@ CheckForLinkerFeature( return !(strstr(Out.buffer, "LNK1117") != NULL || strstr(Err.buffer, "LNK1117") != NULL || strstr(Out.buffer, "LNK4044") != NULL || - strstr(Err.buffer, "LNK4044") != NULL); + strstr(Err.buffer, "LNK4044") != NULL || + strstr(Out.buffer, "LNK4224") != NULL || + strstr(Err.buffer, "LNK4224") != NULL); } static DWORD WINAPI diff --git a/win/rules.vc b/win/rules.vc index ecdd28f..2edaa49 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -190,7 +190,7 @@ COMPILERFLAGS = $(COMPILERFLAGS) -QIA64_Bx # Prevents "LNK1561: entry point must be defined" error compiling from VS-IDE: !ifndef LINKER_TESTFLAGS -LINKER_TESTFLAGS = -entry:_DllMainCRTStartup@12 +LINKER_TESTFLAGS = /DLL /NOENTRY /OUT:nmhlp-out.txt !endif !if "$(MACHINE)" == "IX86" -- cgit v0.12 From dcb024402d1a3c73cf744af89c99f82339dc215c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 13 Jan 2017 11:17:17 +0000 Subject: Patch from Zoran Vasiljevic, fix for missing proper initialization of the threaded allocator in some situations. --- generic/tclEvent.c | 3 --- generic/tclThreadAlloc.c | 1 + unix/tclUnixThrd.c | 2 -- 3 files changed, 1 insertion(+), 5 deletions(-) diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 0eabc13..b0b8188 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1043,9 +1043,6 @@ TclInitSubsystems(void) #if USE_TCLALLOC TclInitAlloc(); /* Process wide mutex init */ #endif -#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) - TclpInitAllocCache(); -#endif #ifdef TCL_MEM_DEBUG TclInitDbCkalloc(); /* Process wide mutex init */ #endif diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index 2ee758e..fc281db 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -210,6 +210,7 @@ GetCache(void) 1 << (NBUCKETS - 2 - i) : 1; bucketInfo[i].lockPtr = TclpNewAllocMutex(); } + TclpInitAllocCache(); } Tcl_MutexUnlock(initLockPtr); } diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 7394545..805599d 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -711,9 +711,7 @@ TclpFreeAllocMutex( void TclpInitAllocCache(void) { - pthread_mutex_lock(allocLockPtr); pthread_key_create(&key, NULL); - pthread_mutex_unlock(allocLockPtr); } void -- cgit v0.12 From db5ec5064a67d11480089bba1753878dc27fbb74 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 13 Jan 2017 12:12:55 +0000 Subject: Enhance nmakehlp, allowing multiple arguments for "-l", and recognizing a new linker code LNK4224. Patch by sebres. --- win/nmakehlp.c | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 84cf75c..22b7b06 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -43,7 +43,7 @@ /* protos */ static int CheckForCompilerFeature(const char *option); -static int CheckForLinkerFeature(const char *option); +static int CheckForLinkerFeature(const char **options, int count); static int IsIn(const char *string, const char *substring); static int SubstituteFile(const char *substs, const char *filename); static int QualifyPath(const char *path); @@ -102,16 +102,16 @@ main( } return CheckForCompilerFeature(argv[2]); case 'l': - if (argc != 3) { + if (argc < 3) { chars = snprintf(msg, sizeof(msg) - 1, - "usage: %s -l \n" + "usage: %s -l ? ...?\n" "Tests for whether link.exe supports an option\n" "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } - return CheckForLinkerFeature(argv[2]); + return CheckForLinkerFeature(&argv[2], argc-2); case 'f': if (argc == 2) { chars = snprintf(msg, sizeof(msg) - 1, @@ -313,7 +313,8 @@ CheckForCompilerFeature( static int CheckForLinkerFeature( - const char *option) + const char **options, + int count) { STARTUPINFO si; PROCESS_INFORMATION pi; @@ -322,7 +323,8 @@ CheckForLinkerFeature( char msg[300]; BOOL ok; HANDLE hProcess, h, pipeThreads[2]; - char cmdline[100]; + int i; + char cmdline[255]; hProcess = GetCurrentProcess(); @@ -368,7 +370,11 @@ CheckForLinkerFeature( * Append our option for testing. */ - lstrcat(cmdline, option); + for (i = 0; i < count; i++) { + lstrcat(cmdline, " \""); + lstrcat(cmdline, options[i]); + lstrcat(cmdline, "\""); + } ok = CreateProcess( NULL, /* Module name. */ @@ -433,7 +439,9 @@ CheckForLinkerFeature( return !(strstr(Out.buffer, "LNK1117") != NULL || strstr(Err.buffer, "LNK1117") != NULL || strstr(Out.buffer, "LNK4044") != NULL || - strstr(Err.buffer, "LNK4044") != NULL); + strstr(Err.buffer, "LNK4044") != NULL || + strstr(Out.buffer, "LNK4224") != NULL || + strstr(Err.buffer, "LNK4224") != NULL); } static DWORD WINAPI -- cgit v0.12 From 59cb3424c88d80880f7441393f913ee185a21357 Mon Sep 17 00:00:00 2001 From: venkat Date: Sat, 14 Jan 2017 08:46:06 +0000 Subject: Upgrade TZDATA to IETF tzdata2016j --- library/tzdata/Asia/Aqtau | 1 - library/tzdata/Asia/Atyrau | 58 +++++++++++++++++++++++++++ library/tzdata/Asia/Famagusta | 91 +++++++++++++++++++++++++++++++++++++++++++ library/tzdata/Asia/Gaza | 22 +++++------ library/tzdata/Asia/Hebron | 22 +++++------ library/tzdata/Europe/Saratov | 71 +++++++++++++++++++++++++++++++++ 6 files changed, 242 insertions(+), 23 deletions(-) create mode 100644 library/tzdata/Asia/Atyrau create mode 100644 library/tzdata/Asia/Famagusta create mode 100644 library/tzdata/Europe/Saratov diff --git a/library/tzdata/Asia/Aqtau b/library/tzdata/Asia/Aqtau index 90cc94d..c128b27 100644 --- a/library/tzdata/Asia/Aqtau +++ b/library/tzdata/Asia/Aqtau @@ -4,7 +4,6 @@ set TZData(:Asia/Aqtau) { {-9223372036854775808 12064 0 LMT} {-1441164064 14400 0 +04} {-1247544000 18000 0 +05} - {-220942800 18000 0 +05} {370724400 21600 0 +06} {386445600 18000 0 +05} {386449200 21600 1 +06} diff --git a/library/tzdata/Asia/Atyrau b/library/tzdata/Asia/Atyrau new file mode 100644 index 0000000..f274540 --- /dev/null +++ b/library/tzdata/Asia/Atyrau @@ -0,0 +1,58 @@ +# created by tools/tclZIC.tcl - do not edit + +set TZData(:Asia/Atyrau) { + {-9223372036854775808 12464 0 LMT} + {-1441164464 14400 0 +04} + {-1247544000 18000 0 +05} + {370724400 21600 0 +06} + {386445600 18000 0 +05} + {386449200 21600 1 +06} + {402256800 18000 0 +05} + {417985200 21600 1 +06} + {433792800 18000 0 +05} + {449607600 21600 1 +06} + {465339600 18000 0 +05} + {481064400 21600 1 +06} + {496789200 18000 0 +05} + {512514000 21600 1 +06} + {528238800 18000 0 +05} + {543963600 21600 1 +06} + {559688400 18000 0 +05} + {575413200 21600 1 +06} + {591138000 18000 0 +05} + {606862800 21600 1 +06} + {622587600 18000 0 +05} + {638312400 21600 1 +06} + {654642000 18000 0 +05} + {670366800 14400 0 +04} + {670370400 18000 1 +05} + {686095200 14400 0 +04} + {695772000 18000 0 +05} + {701816400 21600 1 +06} + {717541200 18000 0 +05} + {733266000 21600 1 +06} + {748990800 18000 0 +05} + {764715600 21600 1 +06} + {780440400 18000 0 +05} + {796165200 21600 1 +06} + {811890000 18000 0 +05} + {828219600 21600 1 +06} + {846363600 18000 0 +05} + {859669200 21600 1 +06} + {877813200 18000 0 +05} + {891118800 21600 1 +06} + {909262800 18000 0 +05} + {922568400 14400 0 +04} + {922572000 18000 1 +05} + {941320800 14400 0 +04} + {954021600 18000 1 +05} + {972770400 14400 0 +04} + {985471200 18000 1 +05} + {1004220000 14400 0 +04} + {1017525600 18000 1 +05} + {1035669600 14400 0 +04} + {1048975200 18000 1 +05} + {1067119200 14400 0 +04} + {1080424800 18000 1 +05} + {1099173600 18000 0 +05} +} diff --git a/library/tzdata/Asia/Famagusta b/library/tzdata/Asia/Famagusta new file mode 100644 index 0000000..384c183 --- /dev/null +++ b/library/tzdata/Asia/Famagusta @@ -0,0 +1,91 @@ +# created by tools/tclZIC.tcl - do not edit + +set TZData(:Asia/Famagusta) { + {-9223372036854775808 8148 0 LMT} + {-1518920148 7200 0 EET} + {166572000 10800 1 EEST} + {182293200 7200 0 EET} + {200959200 10800 1 EEST} + {213829200 7200 0 EET} + {228866400 10800 1 EEST} + {243982800 7200 0 EET} + {260316000 10800 1 EEST} + {276123600 7200 0 EET} + {291765600 10800 1 EEST} + {307486800 7200 0 EET} + {323820000 10800 1 EEST} + {338936400 7200 0 EET} + {354664800 10800 1 EEST} + {370386000 7200 0 EET} + {386114400 10800 1 EEST} + {401835600 7200 0 EET} + {417564000 10800 1 EEST} + {433285200 7200 0 EET} + {449013600 10800 1 EEST} + {465339600 7200 0 EET} + {481068000 10800 1 EEST} + {496789200 7200 0 EET} + {512517600 10800 1 EEST} + {528238800 7200 0 EET} + {543967200 10800 1 EEST} + {559688400 7200 0 EET} + {575416800 10800 1 EEST} + {591138000 7200 0 EET} + {606866400 10800 1 EEST} + {622587600 7200 0 EET} + {638316000 10800 1 EEST} + {654642000 7200 0 EET} + {670370400 10800 1 EEST} + {686091600 7200 0 EET} + {701820000 10800 1 EEST} + {717541200 7200 0 EET} + {733269600 10800 1 EEST} + {748990800 7200 0 EET} + {764719200 10800 1 EEST} + {780440400 7200 0 EET} + {796168800 10800 1 EEST} + {811890000 7200 0 EET} + {828223200 10800 1 EEST} + {843944400 7200 0 EET} + {859672800 10800 1 EEST} + {875394000 7200 0 EET} + {891122400 10800 1 EEST} + {904597200 10800 0 EEST} + {909277200 7200 0 EET} + {922582800 10800 1 EEST} + {941331600 7200 0 EET} + {954032400 10800 1 EEST} + {972781200 7200 0 EET} + {985482000 10800 1 EEST} + {1004230800 7200 0 EET} + {1017536400 10800 1 EEST} + {1035680400 7200 0 EET} + {1048986000 10800 1 EEST} + {1067130000 7200 0 EET} + {1080435600 10800 1 EEST} + {1099184400 7200 0 EET} + {1111885200 10800 1 EEST} + {1130634000 7200 0 EET} + {1143334800 10800 1 EEST} + {1162083600 7200 0 EET} + {1174784400 10800 1 EEST} + {1193533200 7200 0 EET} + {1206838800 10800 1 EEST} + {1224982800 7200 0 EET} + {1238288400 10800 1 EEST} + {1256432400 7200 0 EET} + {1269738000 10800 1 EEST} + {1288486800 7200 0 EET} + {1301187600 10800 1 EEST} + {1319936400 7200 0 EET} + {1332637200 10800 1 EEST} + {1351386000 7200 0 EET} + {1364691600 10800 1 EEST} + {1382835600 7200 0 EET} + {1396141200 10800 1 EEST} + {1414285200 7200 0 EET} + {1427590800 10800 1 EEST} + {1445734800 7200 0 EET} + {1459040400 10800 1 EEST} + {1473285600 10800 0 +03} +} diff --git a/library/tzdata/Asia/Gaza b/library/tzdata/Asia/Gaza index ab53317..1149d51 100644 --- a/library/tzdata/Asia/Gaza +++ b/library/tzdata/Asia/Gaza @@ -2,17 +2,17 @@ set TZData(:Asia/Gaza) { {-9223372036854775808 8272 0 LMT} - {-2185409872 7200 0 EET} - {-933645600 10800 1 EET} - {-857358000 7200 0 EET} - {-844300800 10800 1 EET} - {-825822000 7200 0 EET} - {-812685600 10800 1 EET} - {-794199600 7200 0 EET} - {-779853600 10800 1 EET} - {-762656400 7200 0 EET} - {-748310400 10800 1 EET} - {-731127600 7200 0 EET} + {-2185409872 7200 0 EEST} + {-933645600 10800 1 EEST} + {-857358000 7200 0 EEST} + {-844300800 10800 1 EEST} + {-825822000 7200 0 EEST} + {-812685600 10800 1 EEST} + {-794199600 7200 0 EEST} + {-779853600 10800 1 EEST} + {-762656400 7200 0 EEST} + {-748310400 10800 1 EEST} + {-731127600 7200 0 EEST} {-682653600 7200 0 EET} {-399088800 10800 1 EEST} {-386650800 7200 0 EET} diff --git a/library/tzdata/Asia/Hebron b/library/tzdata/Asia/Hebron index c9f94f2..5d312b8 100644 --- a/library/tzdata/Asia/Hebron +++ b/library/tzdata/Asia/Hebron @@ -2,17 +2,17 @@ set TZData(:Asia/Hebron) { {-9223372036854775808 8423 0 LMT} - {-2185410023 7200 0 EET} - {-933645600 10800 1 EET} - {-857358000 7200 0 EET} - {-844300800 10800 1 EET} - {-825822000 7200 0 EET} - {-812685600 10800 1 EET} - {-794199600 7200 0 EET} - {-779853600 10800 1 EET} - {-762656400 7200 0 EET} - {-748310400 10800 1 EET} - {-731127600 7200 0 EET} + {-2185410023 7200 0 EEST} + {-933645600 10800 1 EEST} + {-857358000 7200 0 EEST} + {-844300800 10800 1 EEST} + {-825822000 7200 0 EEST} + {-812685600 10800 1 EEST} + {-794199600 7200 0 EEST} + {-779853600 10800 1 EEST} + {-762656400 7200 0 EEST} + {-748310400 10800 1 EEST} + {-731127600 7200 0 EEST} {-682653600 7200 0 EET} {-399088800 10800 1 EEST} {-386650800 7200 0 EET} diff --git a/library/tzdata/Europe/Saratov b/library/tzdata/Europe/Saratov new file mode 100644 index 0000000..d89a217 --- /dev/null +++ b/library/tzdata/Europe/Saratov @@ -0,0 +1,71 @@ +# created by tools/tclZIC.tcl - do not edit + +set TZData(:Europe/Saratov) { + {-9223372036854775808 11058 0 LMT} + {-1593820800 10800 0 +03} + {-1247540400 14400 0 +05} + {354916800 18000 1 +05} + {370724400 14400 0 +04} + {386452800 18000 1 +05} + {402260400 14400 0 +04} + {417988800 18000 1 +05} + {433796400 14400 0 +04} + {449611200 18000 1 +05} + {465343200 14400 0 +04} + {481068000 18000 1 +05} + {496792800 14400 0 +04} + {512517600 18000 1 +05} + {528242400 14400 0 +04} + {543967200 18000 1 +05} + {559692000 14400 0 +04} + {575416800 10800 0 +04} + {575420400 14400 1 +04} + {591145200 10800 0 +03} + {606870000 14400 1 +04} + {622594800 10800 0 +03} + {638319600 14400 1 +04} + {654649200 10800 0 +03} + {670374000 14400 0 +04} + {701820000 10800 0 +04} + {701823600 14400 1 +04} + {717548400 10800 0 +03} + {733273200 14400 1 +04} + {748998000 10800 0 +03} + {764722800 14400 1 +04} + {780447600 10800 0 +03} + {796172400 14400 1 +04} + {811897200 10800 0 +03} + {828226800 14400 1 +04} + {846370800 10800 0 +03} + {859676400 14400 1 +04} + {877820400 10800 0 +03} + {891126000 14400 1 +04} + {909270000 10800 0 +03} + {922575600 14400 1 +04} + {941324400 10800 0 +03} + {954025200 14400 1 +04} + {972774000 10800 0 +03} + {985474800 14400 1 +04} + {1004223600 10800 0 +03} + {1017529200 14400 1 +04} + {1035673200 10800 0 +03} + {1048978800 14400 1 +04} + {1067122800 10800 0 +03} + {1080428400 14400 1 +04} + {1099177200 10800 0 +03} + {1111878000 14400 1 +04} + {1130626800 10800 0 +03} + {1143327600 14400 1 +04} + {1162076400 10800 0 +03} + {1174777200 14400 1 +04} + {1193526000 10800 0 +03} + {1206831600 14400 1 +04} + {1224975600 10800 0 +03} + {1238281200 14400 1 +04} + {1256425200 10800 0 +03} + {1269730800 14400 1 +04} + {1288479600 10800 0 +03} + {1301180400 14400 0 +04} + {1414274400 10800 0 +03} + {1480806000 14400 0 +04} +} -- cgit v0.12 From d97147c2533ecc33102bb142a541dfe148ae7224 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 16 Jan 2017 10:23:14 +0000 Subject: Update zlib to version 1.2.11 --- compat/zlib/CMakeLists.txt | 2 +- compat/zlib/ChangeLog | 4 ++++ compat/zlib/Makefile.in | 4 ++-- compat/zlib/README | 4 ++-- compat/zlib/contrib/delphi/ZLib.pas | 2 +- compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs | 2 +- compat/zlib/contrib/infback9/inftree9.c | 4 ++-- compat/zlib/contrib/minizip/configure.ac | 2 +- compat/zlib/contrib/pascal/zlibpas.pas | 2 +- compat/zlib/contrib/vstudio/readme.txt | 2 +- compat/zlib/contrib/vstudio/vc10/zlib.rc | 6 +++--- compat/zlib/contrib/vstudio/vc11/zlib.rc | 6 +++--- compat/zlib/contrib/vstudio/vc12/zlib.rc | 6 +++--- .../zlib/contrib/vstudio/vc14/miniunz.vcxproj.user | 4 ---- .../zlib/contrib/vstudio/vc14/minizip.vcxproj.user | 4 ---- .../contrib/vstudio/vc14/testzlib.vcxproj.user | 4 ---- .../contrib/vstudio/vc14/testzlibdll.vcxproj.user | 4 ---- compat/zlib/contrib/vstudio/vc14/zlib.rc | 6 +++--- .../contrib/vstudio/vc14/zlibstat.vcxproj.user | 4 ---- .../zlib/contrib/vstudio/vc14/zlibvc.vcxproj.user | 4 ---- compat/zlib/contrib/vstudio/vc9/zlib.rc | 6 +++--- compat/zlib/deflate.c | 19 ++++++++++++------- compat/zlib/gzlib.c | 2 +- compat/zlib/gzwrite.c | 2 +- compat/zlib/inffast.c | 2 +- compat/zlib/inftrees.c | 4 ++-- compat/zlib/os400/README400 | 2 +- compat/zlib/os400/make.sh | 2 +- compat/zlib/os400/zlib.inc | 6 +++--- compat/zlib/qnx/package.qpg | 10 +++++----- compat/zlib/treebuild.xml | 4 ++-- compat/zlib/trees.c | 4 ++-- compat/zlib/win32/Makefile.msc | 2 +- compat/zlib/win32/README-WIN32.txt | 6 +++--- compat/zlib/win32/README.txt | 4 ++-- compat/zlib/win32/USAGE.txt | 12 ++++++++++-- compat/zlib/win32/VisualC.txt | 2 +- compat/zlib/win32/zdll.lib | Bin 17152 -> 17152 bytes compat/zlib/win32/zlib1.rc | 2 +- compat/zlib/win64/libz.dll.a | Bin 51638 -> 51638 bytes compat/zlib/win64/zdll.lib | Bin 16740 -> 16740 bytes compat/zlib/win64/zlib1.dll | Bin 116224 -> 116736 bytes compat/zlib/zlib.3 | 4 ++-- compat/zlib/zlib.3.pdf | Bin 19324 -> 19318 bytes compat/zlib/zlib.h | 17 +++++++++-------- compat/zlib/zutil.c | 2 +- 46 files changed, 92 insertions(+), 98 deletions(-) delete mode 100644 compat/zlib/contrib/vstudio/vc14/miniunz.vcxproj.user delete mode 100644 compat/zlib/contrib/vstudio/vc14/minizip.vcxproj.user delete mode 100644 compat/zlib/contrib/vstudio/vc14/testzlib.vcxproj.user delete mode 100644 compat/zlib/contrib/vstudio/vc14/testzlibdll.vcxproj.user delete mode 100644 compat/zlib/contrib/vstudio/vc14/zlibstat.vcxproj.user delete mode 100644 compat/zlib/contrib/vstudio/vc14/zlibvc.vcxproj.user mode change 100644 => 100755 compat/zlib/win32/zdll.lib diff --git a/compat/zlib/CMakeLists.txt b/compat/zlib/CMakeLists.txt index 1a954a6..0fe939d 100644 --- a/compat/zlib/CMakeLists.txt +++ b/compat/zlib/CMakeLists.txt @@ -3,7 +3,7 @@ set(CMAKE_ALLOW_LOOSE_LOOP_CONSTRUCTS ON) project(zlib C) -set(VERSION "1.2.10") +set(VERSION "1.2.11") option(ASM686 "Enable building i686 assembly implementation") option(AMD64 "Enable building amd64 assembly implementation") diff --git a/compat/zlib/ChangeLog b/compat/zlib/ChangeLog index fed9adb..30199a6 100644 --- a/compat/zlib/ChangeLog +++ b/compat/zlib/ChangeLog @@ -1,6 +1,10 @@ ChangeLog file for zlib +Changes in 1.2.11 (15 Jan 2017) +- Fix deflate stored bug when pulling last block from window +- Permit immediate deflateParams changes before any deflate input + Changes in 1.2.10 (2 Jan 2017) - Avoid warnings on snprintf() return value - Fix bug in deflate_stored() for zero-length input diff --git a/compat/zlib/Makefile.in b/compat/zlib/Makefile.in index 1852192..5a77949 100644 --- a/compat/zlib/Makefile.in +++ b/compat/zlib/Makefile.in @@ -1,5 +1,5 @@ # Makefile for zlib -# Copyright (C) 1995-2016 Jean-loup Gailly, Mark Adler +# Copyright (C) 1995-2017 Jean-loup Gailly, Mark Adler # For conditions of distribution and use, see copyright notice in zlib.h # To compile and test, type: @@ -32,7 +32,7 @@ CPP=$(CC) -E STATICLIB=libz.a SHAREDLIB=libz.so -SHAREDLIBV=libz.so.1.2.10 +SHAREDLIBV=libz.so.1.2.11 SHAREDLIBM=libz.so.1 LIBS=$(STATICLIB) $(SHAREDLIBV) diff --git a/compat/zlib/README b/compat/zlib/README index e2250bd..51106de 100644 --- a/compat/zlib/README +++ b/compat/zlib/README @@ -1,6 +1,6 @@ ZLIB DATA COMPRESSION LIBRARY -zlib 1.2.10 is a general purpose data compression library. All the code is +zlib 1.2.11 is a general purpose data compression library. All the code is thread safe. The data format used by the zlib library is described by RFCs (Request for Comments) 1950 to 1952 in the files http://tools.ietf.org/html/rfc1950 (zlib format), rfc1951 (deflate format) and @@ -31,7 +31,7 @@ Mark Nelson wrote an article about zlib for the Jan. 1997 issue of Dr. Dobb's Journal; a copy of the article is available at http://marknelson.us/1997/01/01/zlib-engine/ . -The changes made in version 1.2.10 are documented in the file ChangeLog. +The changes made in version 1.2.11 are documented in the file ChangeLog. Unsupported third party contributions are provided in directory contrib/ . diff --git a/compat/zlib/contrib/delphi/ZLib.pas b/compat/zlib/contrib/delphi/ZLib.pas index e9d72f0..060e199 100644 --- a/compat/zlib/contrib/delphi/ZLib.pas +++ b/compat/zlib/contrib/delphi/ZLib.pas @@ -152,7 +152,7 @@ procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer; const OutBuf: Pointer; BufSize: Integer); const - zlib_version = '1.2.10'; + zlib_version = '1.2.11'; type EZlibError = class(Exception); diff --git a/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs b/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs index a0e3985..44f7633 100644 --- a/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs +++ b/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs @@ -156,7 +156,7 @@ namespace DotZLibTests public void Info_Version() { Info info = new Info(); - Assert.AreEqual("1.2.10", Info.Version); + Assert.AreEqual("1.2.11", Info.Version); Assert.AreEqual(32, info.SizeOfUInt); Assert.AreEqual(32, info.SizeOfULong); Assert.AreEqual(32, info.SizeOfPointer); diff --git a/compat/zlib/contrib/infback9/inftree9.c b/compat/zlib/contrib/infback9/inftree9.c index ea56047..5f4a767 100644 --- a/compat/zlib/contrib/infback9/inftree9.c +++ b/compat/zlib/contrib/infback9/inftree9.c @@ -9,7 +9,7 @@ #define MAXBITS 15 const char inflate9_copyright[] = - " inflate9 1.2.10 Copyright 1995-2017 Mark Adler "; + " inflate9 1.2.11 Copyright 1995-2017 Mark Adler "; /* If you use the zlib library in a product, an acknowledgment is welcome in the documentation of your product. If for some reason you cannot @@ -64,7 +64,7 @@ unsigned short FAR *work; static const unsigned short lext[31] = { /* Length codes 257..285 extra */ 128, 128, 128, 128, 128, 128, 128, 128, 129, 129, 129, 129, 130, 130, 130, 130, 131, 131, 131, 131, 132, 132, 132, 132, - 133, 133, 133, 133, 144, 192, 202}; + 133, 133, 133, 133, 144, 77, 202}; static const unsigned short dbase[32] = { /* Distance codes 0..31 base */ 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073, diff --git a/compat/zlib/contrib/minizip/configure.ac b/compat/zlib/contrib/minizip/configure.ac index bbb2283..5b11970 100644 --- a/compat/zlib/contrib/minizip/configure.ac +++ b/compat/zlib/contrib/minizip/configure.ac @@ -1,7 +1,7 @@ # -*- Autoconf -*- # Process this file with autoconf to produce a configure script. -AC_INIT([minizip], [1.2.10], [bugzilla.redhat.com]) +AC_INIT([minizip], [1.2.11], [bugzilla.redhat.com]) AC_CONFIG_SRCDIR([minizip.c]) AM_INIT_AUTOMAKE([foreign]) LT_INIT diff --git a/compat/zlib/contrib/pascal/zlibpas.pas b/compat/zlib/contrib/pascal/zlibpas.pas index 2330898..a0dff11 100644 --- a/compat/zlib/contrib/pascal/zlibpas.pas +++ b/compat/zlib/contrib/pascal/zlibpas.pas @@ -10,7 +10,7 @@ unit zlibpas; interface const - ZLIB_VERSION = '1.2.10'; + ZLIB_VERSION = '1.2.11'; ZLIB_VERNUM = $12a0; type diff --git a/compat/zlib/contrib/vstudio/readme.txt b/compat/zlib/contrib/vstudio/readme.txt index 98d8a05..f67eae8 100644 --- a/compat/zlib/contrib/vstudio/readme.txt +++ b/compat/zlib/contrib/vstudio/readme.txt @@ -1,4 +1,4 @@ -Building instructions for the DLL versions of Zlib 1.2.10 +Building instructions for the DLL versions of Zlib 1.2.11 ======================================================== This directory contains projects that build zlib and minizip using diff --git a/compat/zlib/contrib/vstudio/vc10/zlib.rc b/compat/zlib/contrib/vstudio/vc10/zlib.rc index f1c19bc..fee177a 100644 --- a/compat/zlib/contrib/vstudio/vc10/zlib.rc +++ b/compat/zlib/contrib/vstudio/vc10/zlib.rc @@ -2,8 +2,8 @@ #define IDR_VERSION1 1 IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE - FILEVERSION 1, 2, 10, 0 - PRODUCTVERSION 1, 2, 10, 0 + FILEVERSION 1, 2, 11, 0 + PRODUCTVERSION 1, 2, 11, 0 FILEFLAGSMASK VS_FFI_FILEFLAGSMASK FILEFLAGS 0 FILEOS VOS_DOS_WINDOWS32 @@ -17,7 +17,7 @@ BEGIN BEGIN VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0" - VALUE "FileVersion", "1.2.10\0" + VALUE "FileVersion", "1.2.11\0" VALUE "InternalName", "zlib\0" VALUE "OriginalFilename", "zlibwapi.dll\0" VALUE "ProductName", "ZLib.DLL\0" diff --git a/compat/zlib/contrib/vstudio/vc11/zlib.rc b/compat/zlib/contrib/vstudio/vc11/zlib.rc index f1c19bc..fee177a 100644 --- a/compat/zlib/contrib/vstudio/vc11/zlib.rc +++ b/compat/zlib/contrib/vstudio/vc11/zlib.rc @@ -2,8 +2,8 @@ #define IDR_VERSION1 1 IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE - FILEVERSION 1, 2, 10, 0 - PRODUCTVERSION 1, 2, 10, 0 + FILEVERSION 1, 2, 11, 0 + PRODUCTVERSION 1, 2, 11, 0 FILEFLAGSMASK VS_FFI_FILEFLAGSMASK FILEFLAGS 0 FILEOS VOS_DOS_WINDOWS32 @@ -17,7 +17,7 @@ BEGIN BEGIN VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0" - VALUE "FileVersion", "1.2.10\0" + VALUE "FileVersion", "1.2.11\0" VALUE "InternalName", "zlib\0" VALUE "OriginalFilename", "zlibwapi.dll\0" VALUE "ProductName", "ZLib.DLL\0" diff --git a/compat/zlib/contrib/vstudio/vc12/zlib.rc b/compat/zlib/contrib/vstudio/vc12/zlib.rc index ef38298..c4e4b01 100644 --- a/compat/zlib/contrib/vstudio/vc12/zlib.rc +++ b/compat/zlib/contrib/vstudio/vc12/zlib.rc @@ -2,8 +2,8 @@ #define IDR_VERSION1 1 IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE - FILEVERSION 1, 2, 10, 0 - PRODUCTVERSION 1, 2, 10, 0 + FILEVERSION 1, 2, 11, 0 + PRODUCTVERSION 1, 2, 11, 0 FILEFLAGSMASK VS_FFI_FILEFLAGSMASK FILEFLAGS 0 FILEOS VOS_DOS_WINDOWS32 @@ -17,7 +17,7 @@ BEGIN BEGIN VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0" - VALUE "FileVersion", "1.2.10\0" + VALUE "FileVersion", "1.2.11\0" VALUE "InternalName", "zlib\0" VALUE "OriginalFilename", "zlibwapi.dll\0" VALUE "ProductName", "ZLib.DLL\0" diff --git a/compat/zlib/contrib/vstudio/vc14/miniunz.vcxproj.user b/compat/zlib/contrib/vstudio/vc14/miniunz.vcxproj.user deleted file mode 100644 index abe8dd8..0000000 --- a/compat/zlib/contrib/vstudio/vc14/miniunz.vcxproj.user +++ /dev/null @@ -1,4 +0,0 @@ - - - - \ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc14/minizip.vcxproj.user b/compat/zlib/contrib/vstudio/vc14/minizip.vcxproj.user deleted file mode 100644 index abe8dd8..0000000 --- a/compat/zlib/contrib/vstudio/vc14/minizip.vcxproj.user +++ /dev/null @@ -1,4 +0,0 @@ - - - - \ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc14/testzlib.vcxproj.user b/compat/zlib/contrib/vstudio/vc14/testzlib.vcxproj.user deleted file mode 100644 index abe8dd8..0000000 --- a/compat/zlib/contrib/vstudio/vc14/testzlib.vcxproj.user +++ /dev/null @@ -1,4 +0,0 @@ - - - - \ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc14/testzlibdll.vcxproj.user b/compat/zlib/contrib/vstudio/vc14/testzlibdll.vcxproj.user deleted file mode 100644 index abe8dd8..0000000 --- a/compat/zlib/contrib/vstudio/vc14/testzlibdll.vcxproj.user +++ /dev/null @@ -1,4 +0,0 @@ - - - - \ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc14/zlib.rc b/compat/zlib/contrib/vstudio/vc14/zlib.rc index ef38298..c4e4b01 100644 --- a/compat/zlib/contrib/vstudio/vc14/zlib.rc +++ b/compat/zlib/contrib/vstudio/vc14/zlib.rc @@ -2,8 +2,8 @@ #define IDR_VERSION1 1 IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE - FILEVERSION 1, 2, 10, 0 - PRODUCTVERSION 1, 2, 10, 0 + FILEVERSION 1, 2, 11, 0 + PRODUCTVERSION 1, 2, 11, 0 FILEFLAGSMASK VS_FFI_FILEFLAGSMASK FILEFLAGS 0 FILEOS VOS_DOS_WINDOWS32 @@ -17,7 +17,7 @@ BEGIN BEGIN VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0" - VALUE "FileVersion", "1.2.10\0" + VALUE "FileVersion", "1.2.11\0" VALUE "InternalName", "zlib\0" VALUE "OriginalFilename", "zlibwapi.dll\0" VALUE "ProductName", "ZLib.DLL\0" diff --git a/compat/zlib/contrib/vstudio/vc14/zlibstat.vcxproj.user b/compat/zlib/contrib/vstudio/vc14/zlibstat.vcxproj.user deleted file mode 100644 index abe8dd8..0000000 --- a/compat/zlib/contrib/vstudio/vc14/zlibstat.vcxproj.user +++ /dev/null @@ -1,4 +0,0 @@ - - - - \ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc14/zlibvc.vcxproj.user b/compat/zlib/contrib/vstudio/vc14/zlibvc.vcxproj.user deleted file mode 100644 index abe8dd8..0000000 --- a/compat/zlib/contrib/vstudio/vc14/zlibvc.vcxproj.user +++ /dev/null @@ -1,4 +0,0 @@ - - - - \ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc9/zlib.rc b/compat/zlib/contrib/vstudio/vc9/zlib.rc index f1c19bc..fee177a 100644 --- a/compat/zlib/contrib/vstudio/vc9/zlib.rc +++ b/compat/zlib/contrib/vstudio/vc9/zlib.rc @@ -2,8 +2,8 @@ #define IDR_VERSION1 1 IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE - FILEVERSION 1, 2, 10, 0 - PRODUCTVERSION 1, 2, 10, 0 + FILEVERSION 1, 2, 11, 0 + PRODUCTVERSION 1, 2, 11, 0 FILEFLAGSMASK VS_FFI_FILEFLAGSMASK FILEFLAGS 0 FILEOS VOS_DOS_WINDOWS32 @@ -17,7 +17,7 @@ BEGIN BEGIN VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0" - VALUE "FileVersion", "1.2.10\0" + VALUE "FileVersion", "1.2.11\0" VALUE "InternalName", "zlib\0" VALUE "OriginalFilename", "zlibwapi.dll\0" VALUE "ProductName", "ZLib.DLL\0" diff --git a/compat/zlib/deflate.c b/compat/zlib/deflate.c index 2ad890e..1ec7614 100644 --- a/compat/zlib/deflate.c +++ b/compat/zlib/deflate.c @@ -52,7 +52,7 @@ #include "deflate.h" const char deflate_copyright[] = - " deflate 1.2.10 Copyright 1995-2017 Jean-loup Gailly and Mark Adler "; + " deflate 1.2.11 Copyright 1995-2017 Jean-loup Gailly and Mark Adler "; /* If you use the zlib library in a product, an acknowledgment is welcome in the documentation of your product. If for some reason you cannot @@ -586,7 +586,8 @@ int ZEXPORT deflateParams(strm, level, strategy) } func = configuration_table[s->level].func; - if ((strategy != s->strategy || func != configuration_table[level].func)) { + if ((strategy != s->strategy || func != configuration_table[level].func) && + s->high_water) { /* Flush the last buffer: */ int err = deflate(strm, Z_BLOCK); if (err == Z_STREAM_ERROR) @@ -1671,8 +1672,6 @@ local block_state deflate_stored(s, flush) len = left + s->strm->avail_in; /* limit len to the input */ if (len > have) len = have; /* limit len to the output */ - if (left > len) - left = len; /* limit window pull to len */ /* If the stored block would be less than min_block in length, or if * unable to copy all of the available input when flushing, then try @@ -1681,13 +1680,13 @@ local block_state deflate_stored(s, flush) */ if (len < min_block && ((len == 0 && flush != Z_FINISH) || flush == Z_NO_FLUSH || - len - left != s->strm->avail_in)) + len != left + s->strm->avail_in)) break; /* Make a dummy stored block in pending to get the header bytes, * including any pending bits. This also updates the debugging counts. */ - last = flush == Z_FINISH && len - left == s->strm->avail_in ? 1 : 0; + last = flush == Z_FINISH && len == left + s->strm->avail_in ? 1 : 0; _tr_stored_block(s, (char *)0, 0L, last); /* Replace the lengths in the dummy stored block with len. */ @@ -1699,14 +1698,16 @@ local block_state deflate_stored(s, flush) /* Write the stored block header bytes. */ flush_pending(s->strm); - /* Update debugging counts for the data about to be copied. */ #ifdef ZLIB_DEBUG + /* Update debugging counts for the data about to be copied. */ s->compressed_len += len << 3; s->bits_sent += len << 3; #endif /* Copy uncompressed bytes from the window to next_out. */ if (left) { + if (left > len) + left = len; zmemcpy(s->strm->next_out, s->window + s->block_start, left); s->strm->next_out += left; s->strm->avail_out -= left; @@ -1756,6 +1757,8 @@ local block_state deflate_stored(s, flush) s->block_start = s->strstart; s->insert += MIN(used, s->w_size - s->insert); } + if (s->high_water < s->strstart) + s->high_water = s->strstart; /* If the last block was written to next_out, then done. */ if (last) @@ -1783,6 +1786,8 @@ local block_state deflate_stored(s, flush) read_buf(s->strm, s->window + s->strstart, have); s->strstart += have; } + if (s->high_water < s->strstart) + s->high_water = s->strstart; /* There was not enough avail_out to write a complete worthy or flushed * stored block to next_out. Write a stored block to pending instead, if we diff --git a/compat/zlib/gzlib.c b/compat/zlib/gzlib.c index e142ffb..4105e6a 100644 --- a/compat/zlib/gzlib.c +++ b/compat/zlib/gzlib.c @@ -1,5 +1,5 @@ /* gzlib.c -- zlib functions common to reading and writing gzip files - * Copyright (C) 2004, 2010, 2011, 2012, 2013, 2016 Mark Adler + * Copyright (C) 2004-2017 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ diff --git a/compat/zlib/gzwrite.c b/compat/zlib/gzwrite.c index 1ec1da4..c7b5651 100644 --- a/compat/zlib/gzwrite.c +++ b/compat/zlib/gzwrite.c @@ -1,5 +1,5 @@ /* gzwrite.c -- zlib functions for writing gzip files - * Copyright (C) 2004, 2005, 2010, 2011, 2012, 2013, 2016 Mark Adler + * Copyright (C) 2004-2017 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ diff --git a/compat/zlib/inffast.c b/compat/zlib/inffast.c index 29eb7d8..0dbd1db 100644 --- a/compat/zlib/inffast.c +++ b/compat/zlib/inffast.c @@ -1,5 +1,5 @@ /* inffast.c -- fast decoding - * Copyright (C) 1995-2008, 2010, 2013, 2016 Mark Adler + * Copyright (C) 1995-2017 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ diff --git a/compat/zlib/inftrees.c b/compat/zlib/inftrees.c index 8a904dd..2ea08fc 100644 --- a/compat/zlib/inftrees.c +++ b/compat/zlib/inftrees.c @@ -9,7 +9,7 @@ #define MAXBITS 15 const char inflate_copyright[] = - " inflate 1.2.10 Copyright 1995-2017 Mark Adler "; + " inflate 1.2.11 Copyright 1995-2017 Mark Adler "; /* If you use the zlib library in a product, an acknowledgment is welcome in the documentation of your product. If for some reason you cannot @@ -62,7 +62,7 @@ unsigned short FAR *work; 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0}; static const unsigned short lext[31] = { /* Length codes 257..285 extra */ 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 18, - 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 192, 202}; + 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 77, 202}; static const unsigned short dbase[32] = { /* Distance codes 0..29 base */ 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, diff --git a/compat/zlib/os400/README400 b/compat/zlib/os400/README400 index 28dca8c..4f98334 100644 --- a/compat/zlib/os400/README400 +++ b/compat/zlib/os400/README400 @@ -1,4 +1,4 @@ - ZLIB version 1.2.10 for OS/400 installation instructions + ZLIB version 1.2.11 for OS/400 installation instructions 1) Download and unpack the zlib tarball to some IFS directory. (i.e.: /path/to/the/zlib/ifs/source/directory) diff --git a/compat/zlib/os400/make.sh b/compat/zlib/os400/make.sh index ddbfb16..19eec11 100644 --- a/compat/zlib/os400/make.sh +++ b/compat/zlib/os400/make.sh @@ -260,7 +260,7 @@ fi echo '#pragma comment(user, "ZLIB version '"${VERSION}"'")' > os400.c echo '#pragma comment(user, __DATE__)' >> os400.c echo '#pragma comment(user, __TIME__)' >> os400.c -echo '#pragma comment(copyright, "Copyright (C) 1995-2016 Jean-Loup Gailly, Mark Adler. OS/400 version by P. Monnerat.")' >> os400.c +echo '#pragma comment(copyright, "Copyright (C) 1995-2017 Jean-Loup Gailly, Mark Adler. OS/400 version by P. Monnerat.")' >> os400.c make_module OS400 os400.c LINK= # No need to rebuild service program yet. MODULES= diff --git a/compat/zlib/os400/zlib.inc b/compat/zlib/os400/zlib.inc index a2147dd..c6aca2c 100644 --- a/compat/zlib/os400/zlib.inc +++ b/compat/zlib/os400/zlib.inc @@ -1,7 +1,7 @@ * ZLIB.INC - Interface to the general purpose compression library * * ILE RPG400 version by Patrick Monnerat, DATASPHERE. - * Version 1.2.10 + * Version 1.2.11 * * * WARNING: @@ -22,12 +22,12 @@ * * Versioning information. * - D ZLIB_VERSION C '1.2.10' + D ZLIB_VERSION C '1.2.11' D ZLIB_VERNUM C X'12a0' D ZLIB_VER_MAJOR C 1 D ZLIB_VER_MINOR C 2 D ZLIB_VER_REVISION... - D C 10 + D C 11 D ZLIB_VER_SUBREVISION... D C 0 * diff --git a/compat/zlib/qnx/package.qpg b/compat/zlib/qnx/package.qpg index d9a1229..31e8e90 100644 --- a/compat/zlib/qnx/package.qpg +++ b/compat/zlib/qnx/package.qpg @@ -25,10 +25,10 @@ - - - - + + + + @@ -63,7 +63,7 @@ - 1.2.10 + 1.2.11 Medium Stable diff --git a/compat/zlib/treebuild.xml b/compat/zlib/treebuild.xml index a530cc0..fd75525 100644 --- a/compat/zlib/treebuild.xml +++ b/compat/zlib/treebuild.xml @@ -1,6 +1,6 @@ - - + + zip compression library diff --git a/compat/zlib/trees.c b/compat/zlib/trees.c index 357f313..50cf4b4 100644 --- a/compat/zlib/trees.c +++ b/compat/zlib/trees.c @@ -1,5 +1,5 @@ /* trees.c -- output deflated data using Huffman coding - * Copyright (C) 1995-2016 Jean-loup Gailly + * Copyright (C) 1995-2017 Jean-loup Gailly * detect_data_type() function provided freely by Cosmin Truta, 2006 * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -906,7 +906,7 @@ void ZLIB_INTERNAL _tr_align(s) /* =========================================================================== * Determine the best encoding for the current block: dynamic trees, static - * trees or store, and output the encoded block to the zip file. + * trees or store, and write out the encoded block. */ void ZLIB_INTERNAL _tr_flush_block(s, buf, stored_len, last) deflate_state *s; diff --git a/compat/zlib/win32/Makefile.msc b/compat/zlib/win32/Makefile.msc index 67b7731..6831882 100644 --- a/compat/zlib/win32/Makefile.msc +++ b/compat/zlib/win32/Makefile.msc @@ -1,5 +1,5 @@ # Makefile for zlib using Microsoft (Visual) C -# zlib is copyright (C) 1995-2006 Jean-loup Gailly and Mark Adler +# zlib is copyright (C) 1995-2017 Jean-loup Gailly and Mark Adler # # Usage: # nmake -f win32/Makefile.msc (standard build) diff --git a/compat/zlib/win32/README-WIN32.txt b/compat/zlib/win32/README-WIN32.txt index 16adcca..df7ab7f 100644 --- a/compat/zlib/win32/README-WIN32.txt +++ b/compat/zlib/win32/README-WIN32.txt @@ -1,6 +1,6 @@ ZLIB DATA COMPRESSION LIBRARY -zlib 1.2.10 is a general purpose data compression library. All the code is +zlib 1.2.11 is a general purpose data compression library. All the code is thread safe. The data format used by the zlib library is described by RFCs (Request for Comments) 1950 to 1952 in the files http://www.ietf.org/rfc/rfc1950.txt (zlib format), rfc1951.txt (deflate format) @@ -22,7 +22,7 @@ before asking for help. Manifest: -The package zlib-1.2.10-win32-x86.zip will contain the following files: +The package zlib-1.2.11-win32-x86.zip will contain the following files: README-WIN32.txt This document ChangeLog Changes since previous zlib packages @@ -72,7 +72,7 @@ are too numerous to cite here. Copyright notice: - (C) 1995-2012 Jean-loup Gailly and Mark Adler + (C) 1995-2017 Jean-loup Gailly and Mark Adler This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages diff --git a/compat/zlib/win32/README.txt b/compat/zlib/win32/README.txt index de1d05a..bd3d18d 100644 --- a/compat/zlib/win32/README.txt +++ b/compat/zlib/win32/README.txt @@ -6,7 +6,7 @@ What's here Source ====== - zlib version 1.2.10 + zlib version 1.2.11 available at http://www.gzip.org/zlib/ @@ -37,7 +37,7 @@ Build info Copyright notice ================ - Copyright (C) 1995-2010 Jean-loup Gailly and Mark Adler + Copyright (C) 1995-2017 Jean-loup Gailly and Mark Adler This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages diff --git a/compat/zlib/win32/USAGE.txt b/compat/zlib/win32/USAGE.txt index 48e594e..22829eb 100644 --- a/compat/zlib/win32/USAGE.txt +++ b/compat/zlib/win32/USAGE.txt @@ -2,6 +2,9 @@ Installing ZLIB1.DLL ==================== Copy ZLIB1.DLL to the SYSTEM or the SYSTEM32 directory. + + If you want to install the 32-bit dll on a 64-bit + machine, use the SysWOW64 directory instead. Using ZLIB1.DLL with Microsoft Visual C++ @@ -20,12 +23,17 @@ Using ZLIB1.DLL with gcc/MinGW 1. Install the supplied header files "zlib.h" and "zconf.h" into the INCLUDE directory. - 2. Copy the supplied library file "zdll.lib" to "libzdll.a": + 2. (32-bit): Copy the supplied library file "zdll.lib" to "libzdll.a": cp lib/zdll.lib lib/libzdll.a OR - 2' Build the import library from the supplied "zlib.def": + 2'. (64-bit): Copy the supplied library file "libz.dll.a" to "libzdll.a": + cp lib/libz.dll.a lib/libzdll.a + + OR + + 2'' Build the import library from the supplied "zlib.def": dlltool -D zlib1.dll -d lib/zlib.def -l lib/libzdll.a 3. Install "libzdll.a" into the LIB directory. diff --git a/compat/zlib/win32/VisualC.txt b/compat/zlib/win32/VisualC.txt index 579a5fc..1005b21 100644 --- a/compat/zlib/win32/VisualC.txt +++ b/compat/zlib/win32/VisualC.txt @@ -1,3 +1,3 @@ To build zlib using the Microsoft Visual C++ environment, -use the appropriate project from the projects/ directory. +use the appropriate project from the contrib/vstudio/ directory. diff --git a/compat/zlib/win32/zdll.lib b/compat/zlib/win32/zdll.lib old mode 100644 new mode 100755 index 5807541..a3e9a39 Binary files a/compat/zlib/win32/zdll.lib and b/compat/zlib/win32/zdll.lib differ diff --git a/compat/zlib/win32/zlib1.rc b/compat/zlib/win32/zlib1.rc index 5c0feed..234e641 100644 --- a/compat/zlib/win32/zlib1.rc +++ b/compat/zlib/win32/zlib1.rc @@ -26,7 +26,7 @@ BEGIN VALUE "FileDescription", "zlib data compression library\0" VALUE "FileVersion", ZLIB_VERSION "\0" VALUE "InternalName", "zlib1.dll\0" - VALUE "LegalCopyright", "(C) 1995-2013 Jean-loup Gailly & Mark Adler\0" + VALUE "LegalCopyright", "(C) 1995-2017 Jean-loup Gailly & Mark Adler\0" VALUE "OriginalFilename", "zlib1.dll\0" VALUE "ProductName", "zlib\0" VALUE "ProductVersion", ZLIB_VERSION "\0" diff --git a/compat/zlib/win64/libz.dll.a b/compat/zlib/win64/libz.dll.a index d90a90c..93be06e 100644 Binary files a/compat/zlib/win64/libz.dll.a and b/compat/zlib/win64/libz.dll.a differ diff --git a/compat/zlib/win64/zdll.lib b/compat/zlib/win64/zdll.lib index db56951..c1be098 100644 Binary files a/compat/zlib/win64/zdll.lib and b/compat/zlib/win64/zdll.lib differ diff --git a/compat/zlib/win64/zlib1.dll b/compat/zlib/win64/zlib1.dll index 86b6bbe..81195c3 100755 Binary files a/compat/zlib/win64/zlib1.dll and b/compat/zlib/win64/zlib1.dll differ diff --git a/compat/zlib/zlib.3 b/compat/zlib/zlib.3 index 00dc061..bda4eb0 100644 --- a/compat/zlib/zlib.3 +++ b/compat/zlib/zlib.3 @@ -1,4 +1,4 @@ -.TH ZLIB 3 "2 Jan 2017" +.TH ZLIB 3 "15 Jan 2017" .SH NAME zlib \- compression/decompression library .SH SYNOPSIS @@ -105,7 +105,7 @@ before asking for help. Send questions and/or comments to zlib@gzip.org, or (for the Windows DLL version) to Gilles Vollant (info@winimage.com). .SH AUTHORS AND LICENSE -Version 1.2.10 +Version 1.2.11 .LP Copyright (C) 1995-2017 Jean-loup Gailly and Mark Adler .LP diff --git a/compat/zlib/zlib.3.pdf b/compat/zlib/zlib.3.pdf index 20008cd..6fa519c 100644 Binary files a/compat/zlib/zlib.3.pdf and b/compat/zlib/zlib.3.pdf differ diff --git a/compat/zlib/zlib.h b/compat/zlib/zlib.h index dc90dc8..f09cdaf 100644 --- a/compat/zlib/zlib.h +++ b/compat/zlib/zlib.h @@ -1,5 +1,5 @@ /* zlib.h -- interface of the 'zlib' general purpose compression library - version 1.2.10, January 2nd, 2017 + version 1.2.11, January 15th, 2017 Copyright (C) 1995-2017 Jean-loup Gailly and Mark Adler @@ -37,11 +37,11 @@ extern "C" { #endif -#define ZLIB_VERSION "1.2.10" -#define ZLIB_VERNUM 0x12a0 +#define ZLIB_VERSION "1.2.11" +#define ZLIB_VERNUM 0x12b0 #define ZLIB_VER_MAJOR 1 #define ZLIB_VER_MINOR 2 -#define ZLIB_VER_REVISION 10 +#define ZLIB_VER_REVISION 11 #define ZLIB_VER_SUBREVISION 0 /* @@ -712,10 +712,11 @@ ZEXTERN int ZEXPORT deflateParams OF((z_streamp strm, used to switch between compression and straight copy of the input data, or to switch to a different kind of input data requiring a different strategy. If the compression approach (which is a function of the level) or the - strategy is changed, then the input available so far is compressed with the - old level and strategy using deflate(strm, Z_BLOCK). There are three - approaches for the compression levels 0, 1..3, and 4..9 respectively. The - new level and strategy will take effect at the next call of deflate(). + strategy is changed, and if any input has been consumed in a previous + deflate() call, then the input available so far is compressed with the old + level and strategy using deflate(strm, Z_BLOCK). There are three approaches + for the compression levels 0, 1..3, and 4..9 respectively. The new level + and strategy will take effect at the next call of deflate(). If a deflate(strm, Z_BLOCK) is performed by deflateParams(), and it does not have enough output space to complete, then the parameter change will not diff --git a/compat/zlib/zutil.c b/compat/zlib/zutil.c index 56534fb..a76c6b0 100644 --- a/compat/zlib/zutil.c +++ b/compat/zlib/zutil.c @@ -1,5 +1,5 @@ /* zutil.c -- target dependent utility functions for the compression library - * Copyright (C) 1995-2005, 2010, 2011, 2012, 2016 Jean-loup Gailly + * Copyright (C) 1995-2017 Jean-loup Gailly * For conditions of distribution and use, see copyright notice in zlib.h */ -- cgit v0.12 From 9dcacf853204f3d0a155842d157fe8de21d61eff Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 17 Jan 2017 09:02:13 +0000 Subject: Hm. 32-bit zlib dll still was the 1.2.10 version. Corrected now. --- compat/zlib/win32/zlib1.dll | Bin 104960 -> 105472 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/compat/zlib/win32/zlib1.dll b/compat/zlib/win32/zlib1.dll index 81f53ec..3196f4a 100755 Binary files a/compat/zlib/win32/zlib1.dll and b/compat/zlib/win32/zlib1.dll differ -- cgit v0.12 From 592e0f1dd91bee030010bd5efb84d9f6d976f22a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 17 Jan 2017 10:00:58 +0000 Subject: Test-cases which require Tcl 8.5 (or 8.6) should continue to work unmodified in Tcl 9.0. The "novem" branch will show whether this continues to work. --- tests/all.tcl | 2 +- tests/httpd11.tcl | 2 +- tests/httpold.test | 2 +- tests/msgcat.test | 48 ++++++++++++++++++++++++------------------------ tests/safe.test | 2 +- tests/tm.test | 4 ++-- 6 files changed, 30 insertions(+), 30 deletions(-) diff --git a/tests/all.tcl b/tests/all.tcl index 0a6f57f..69a16ba 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -11,7 +11,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package prefer latest -package require Tcl 8.5 +package require Tcl 8.5- package require tcltest 2.2 namespace import tcltest::* configure {*}$argv -testdir [file dir [info script]] diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl index 6eae2b7..7880494 100644 --- a/tests/httpd11.tcl +++ b/tests/httpd11.tcl @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.6 +package require Tcl 8.6- proc ::tcl::dict::get? {dict key} { if {[dict exists $dict $key]} { diff --git a/tests/httpold.test b/tests/httpold.test index aeba311..5995bed 100644 --- a/tests/httpold.test +++ b/tests/httpold.test @@ -36,7 +36,7 @@ if {[catch {package require http 1.0}]} { set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null" catch {unset data} -## +## ## The httpd script implement a stub http server ## source [file join [file dirname [info script]] httpd] diff --git a/tests/msgcat.test b/tests/msgcat.test index ae35272..1c3ce58 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -12,7 +12,7 @@ # Note that after running these tests, entries will be left behind in the # message catalogs for locales foo, foo_BAR, and foo_BAR_baz. -package require Tcl 8.5 +package require Tcl 8.5- if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." return @@ -51,7 +51,7 @@ namespace eval ::msgcat::test { variable body variable result variable setVars - foreach setVars [PowerSet $envVars] { + foreach setVars [PowerSet $envVars] { set result [string tolower [lindex $setVars 0]] if {[string length $result] == 0} { if {[info exists ::tcl::mac::locale]} { @@ -94,7 +94,7 @@ namespace eval ::msgcat::test { incr count } unset -nocomplain result - + # Could add tests of initialization from Windows registry here. # Use a fake registry package. @@ -294,11 +294,11 @@ namespace eval ::msgcat::test { variable count 2 variable result array set result { - foo,ov0 ov0_ROOT foo,ov1 ov1_foo foo,ov2 ov2_foo + foo,ov0 ov0_ROOT foo,ov1 ov1_foo foo,ov2 ov2_foo foo,ov3 ov3_foo foo,ov4 ov4 - foo_BAR,ov0 ov0_ROOT foo_BAR,ov1 ov1_foo foo_BAR,ov2 ov2_foo_BAR - foo_BAR,ov3 ov3_foo_BAR foo_BAR,ov4 ov4 - foo_BAR_baz,ov0 ov0_ROOT foo_BAR_baz,ov1 ov1_foo + foo_BAR,ov0 ov0_ROOT foo_BAR,ov1 ov1_foo foo_BAR,ov2 ov2_foo_BAR + foo_BAR,ov3 ov3_foo_BAR foo_BAR,ov4 ov4 + foo_BAR_baz,ov0 ov0_ROOT foo_BAR_baz,ov1 ov1_foo foo_BAR_baz,ov2 ov2_foo_BAR foo_BAR_baz,ov3 ov3_foo_BAR_baz foo_BAR_baz,ov4 ov4 } @@ -417,12 +417,12 @@ namespace eval ::msgcat::test { variable locale [mclocale] ::msgcat::mclocale "" ::msgcat::mcloadedlocales clear - ::msgcat::mcpackageconfig unset mcfolder + ::msgcat::mcpackageconfig unset mcfolder mclocale $loc } -cleanup { mclocale $locale ::msgcat::mcloadedlocales clear - ::msgcat::mcpackageconfig unset mcfolder + ::msgcat::mcpackageconfig unset mcfolder } -body { mcload $msgdir } -result [expr { $count+1 }] @@ -437,7 +437,7 @@ namespace eval ::msgcat::test { } -cleanup { mclocale $locale mcloadedlocales clear - mcpackageconfig unset mcfolder + mcpackageconfig unset mcfolder } -body { mcload $msgdir } -result 3 @@ -448,7 +448,7 @@ namespace eval ::msgcat::test { } -cleanup { mclocale $locale mcloadedlocales clear - mcpackageconfig unset mcfolder + mcpackageconfig unset mcfolder } -body { mcload $msgdir } -result 1 @@ -517,7 +517,7 @@ namespace eval ::msgcat::test { } -cleanup { mclocale $locale mcloadedlocales clear - mcpackageconfig unset mcfolder + mcpackageconfig unset mcfolder } -body { mclocale foo mcpackageconfig set mcfolder $msgdir @@ -536,7 +536,7 @@ namespace eval ::msgcat::test { # Tests msgcat-6.*: [mcset], [mc] namespace inheritance # # Test mcset and mc, ensuring that resolution for messages -# proceeds from the current ns to its parent and so on to the +# proceeds from the current ns to its parent and so on to the # global ns. # # Do this for the 12 permutations of @@ -580,7 +580,7 @@ namespace eval ::msgcat::test { ::msgcat::mcset foo ov3 "ov3_foo_bar_baz" } } - + } variable locale [mclocale] mclocale foo @@ -689,12 +689,12 @@ namespace eval ::msgcat::test { mcexists } -returnCodes 1\ -result {wrong # args: should be "mcexists ?-exactnamespace? ?-exactlocale? src"} - + test msgcat-9.2 {mcexists unknown option} -body { - mcexists -unknown src + mcexists -unknown src } -returnCodes 1\ -result {unknown option "-unknown"} - + test msgcat-9.3 {mcexists} -setup { mcforgetpackage variable locale [mclocale] @@ -716,7 +716,7 @@ namespace eval ::msgcat::test { } -body { list [mcexists k1] [mcexists -exactlocale k1] } -result {1 0} - + test msgcat-9.5 {mcexists parent namespace} -setup { mcforgetpackage variable locale [mclocale] @@ -730,19 +730,19 @@ namespace eval ::msgcat::test { [::msgcat::mcexists -exactnamespace k1] } } -result {1 0} - + # Tests msgcat-10.*: [mcloadedlocales] test msgcat-10.1 {mcloadedlocales no arg} -body { mcloadedlocales } -returnCodes 1\ -result {wrong # args: should be "mcloadedlocales subcommand"} - + test msgcat-10.2 {mcloadedlocales wrong subcommand} -body { mcloadedlocales junk } -returnCodes 1\ -result {unknown subcommand "junk": must be clear, or loaded} - + test msgcat-10.3 {mcloadedlocales loaded} -setup { mcforgetpackage variable locale [mclocale] @@ -755,7 +755,7 @@ namespace eval ::msgcat::test { # The result is position independent so sort set resultlist [lsort [mcloadedlocales loaded]] } -result {{} foo foo_bar} - + test msgcat-10.4 {mcloadedlocales clear} -setup { mcforgetpackage variable locale [mclocale] @@ -961,9 +961,9 @@ namespace eval ::msgcat::test { } -result {0 0 1 0} # option mcfolder is already tested with 5.11 - + # Tests msgcat-14.*: callbacks: loadcmd, changecmd, unknowncmd - + # This routine is used as bgerror and by direct callback invocation proc callbackproc args { variable resultvariable diff --git a/tests/safe.test b/tests/safe.test index 6c9c6c9..e43ce12 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -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. -package require Tcl 8.5 +package require Tcl 8.5- if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 diff --git a/tests/tm.test b/tests/tm.test index 1b22f8c..567d351 100644 --- a/tests/tm.test +++ b/tests/tm.test @@ -6,7 +6,7 @@ # Copyright (c) 2004 by Donal K. Fellows. # All rights reserved. -package require Tcl 8.5 +package require Tcl 8.5- if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* @@ -200,7 +200,7 @@ test tm-3.11 {tm: module path management, remove ignores unknown path} -setup { proc genpaths {base} { # Normalizing picks up drive letters on windows [Bug 1053568] set base [file normalize $base] - lassign [split [package present Tcl] .] major minor + lassign [split [package present Tcl] .] major minor set results {} set base [file join $base tcl$major] lappend results [file join $base site-tcl] -- cgit v0.12 From c3dbeb6e6ff78ff7393f4546ab4156aa1262e859 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 17 Jan 2017 12:02:43 +0000 Subject: Implement tag "deprecated" in genStubs.tcl. Will be used in Tk 8.7, for tagging the deprecated function Tk_FreeXId() --- tools/genStubs.tcl | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 9f2c6ca..742aa46 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -199,6 +199,13 @@ proc genStubs::declare {args} { set stubs($curName,$platform,lastNum) $index } } + if {$platformList eq "deprecated"} { + set stubs($curName,generic,$index) $decl + if {![info exists stubs($curName,generic,lastNum)] \ + || ($index > $stubs($curName,generic,lastNum))} { + set stubs($curName,$platform,lastNum) $index + } + } } return } @@ -455,10 +462,16 @@ proc genStubs::parseArg {arg} { proc genStubs::makeDecl {name decl index} { variable scspec + variable stubs + variable libraryName lassign $decl rtype fname args append text "/* $index */\n" + if {[info exists stubs($name,deprecated,$index)]} { + set line "[string toupper $libraryName]_DEPRECATED $rtype" + } else { set line "$scspec $rtype" + } set count [expr {2 - ([string length $line] / 8)}] append line [string range "\t\t\t" 0 $count] set pad [expr {24 - [string length $line]}] @@ -682,7 +695,10 @@ proc genStubs::forAllStubs {name slotProc onAll textVar for {set i 0} {$i <= $lastNum} {incr i} { set slots [array names stubs $name,*,$i] set emit 0 - if {[info exists stubs($name,generic,$i)]} { + if {[info exists stubs($name,deprecated,$i)]} { + append text [$slotProc $name $stubs($name,generic,$i) $i] + set emit 1 + } elseif {[info exists stubs($name,generic,$i)]} { if {[llength $slots] > 1} { puts stderr "conflicting generic and platform entries:\ $name $i" -- cgit v0.12 From 3f648e4efddf57078b99ef451e9418fbec4b3abe Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 19 Jan 2017 22:37:48 +0000 Subject: Fix [1f4bb8162f]: lsort -dictionary documentation to be improved --- doc/lsort.n | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/doc/lsort.n b/doc/lsort.n index b0f7973..c3245b2 100644 --- a/doc/lsort.n +++ b/doc/lsort.n @@ -40,7 +40,8 @@ except (a) case is ignored except as a tie-breaker and (b) if two strings contain embedded numbers, the numbers compare as integers, not characters. For example, in \fB\-dictionary\fR mode, \fBbigBoy\fR sorts between \fBbigbang\fR and \fBbigboy\fR, and \fBx10y\fR -sorts between \fBx9y\fR and \fBx11y\fR. +sorts between \fBx9y\fR and \fBx11y\fR. Overrides the \fB\-nocase\fR +option. .TP \fB\-integer\fR . -- cgit v0.12 From f421ab92dcd3d8e15e14424401e18ace004fbb5e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 20 Jan 2017 16:18:00 +0000 Subject: Fix [39f6304c2e90549c209cd11a7920dc9921b9f48e|39f6304c2e] follow-up: Make Tcl_LinkVar toleranto to the empty string as well --- generic/tclLink.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/generic/tclLink.c b/generic/tclLink.c index 0b21997..2dc2e47 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -724,8 +724,8 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) { /* * This function checks for integer representations, which are valid * when linking with C variables, but which are invalid in other - * contexts in Tcl. Handled are "+", "-", "0x", "0b" and "0o" (upper- - * and lowercase). See bug [39f6304c2e]. + * contexts in Tcl. Handled are "", "+", "-", "0x", "0b" and "0o" + * (upperand lowercase). See bug [39f6304c2e]. */ int GetInvalidIntFromObj(Tcl_Obj *objPtr, @@ -737,7 +737,8 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr, if ((length == 1) && strchr("+-", str[0])) { *intPtr = (str[0] == '+'); return TCL_OK; - } else if ((length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1])) { + } else if ((length == 0) || + ((length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) { *intPtr = 0; return TCL_OK; } -- cgit v0.12 From d95abe6b6fe069f55ce27900c99fec5949d63a15 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 25 Jan 2017 12:22:16 +0000 Subject: If TCL_NO_DEPRECATED is defined, remove the "case" statement, and use much less interp->result. Implementation mostly taken over from "novem". If TCL_NO_DEPRECATED is not defined, nothing changes. --- generic/tclBasic.c | 2 +- generic/tclCmdAH.c | 3 ++- generic/tclDecls.h | 16 +++++++++++++++ generic/tclIO.c | 41 -------------------------------------- generic/tclInt.h | 2 ++ generic/tclResult.c | 55 +++++++++++++++++++++++++++++++++++++++------------ generic/tclStubInit.c | 41 ++++++++++++++++++++++++++++++++++++-- generic/tclTest.c | 20 ++++++++----------- generic/tclUtil.c | 17 ++++++++++++---- tests/case.test | 5 +++++ tests/result.test | 4 ++-- tools/configure | 2 +- 12 files changed, 131 insertions(+), 77 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 37dd699..b4d0a7b 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -203,7 +203,7 @@ static const CmdInfo builtInCmds[] = { {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, -#ifndef EXCLUDE_OBSOLETE_COMMANDS +#ifndef TCL_NO_DEPRECATED {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, #endif {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 4c299f8..9c6f6a1 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -149,7 +149,7 @@ Tcl_BreakObjCmd( * *---------------------------------------------------------------------- */ - +#ifndef TCL_NO_DEPRECATED /* ARGSUSED */ int Tcl_CaseObjCmd( @@ -267,6 +267,7 @@ Tcl_CaseObjCmd( return TCL_OK; } +#endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 504af18..0dbf345 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3869,6 +3869,22 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_AddObjErrorInfo #define Tcl_AddObjErrorInfo(interp, message, length) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length)) +#ifdef TCL_NO_DEPRECATED +#undef Tcl_SetResult +#define Tcl_SetResult(interp, result, freeProc) \ + do { \ + char *__result = result; \ + Tcl_FreeProc *__freeProc = freeProc; \ + Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \ + if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \ + if (__freeProc == TCL_DYNAMIC) { \ + ckfree(__result); \ + } else { \ + (*__freeProc)(__result); \ + } \ + } \ + } while(0) +#endif /* TCL_NO_DEPRECATED */ #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) # if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG) diff --git a/generic/tclIO.c b/generic/tclIO.c index 5c39e19..506e6d5 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7127,47 +7127,6 @@ Tcl_Tell( /* *--------------------------------------------------------------------------- * - * Tcl_SeekOld, Tcl_TellOld -- - * - * Backward-compatibility versions of the seek/tell interface that do not - * support 64-bit offsets. This interface is not documented or expected - * to be supported indefinitely. - * - * Results: - * As for Tcl_Seek and Tcl_Tell respectively, except truncated to - * whatever value will fit in an 'int'. - * - * Side effects: - * As for Tcl_Seek and Tcl_Tell respectively. - * - *--------------------------------------------------------------------------- - */ - -int -Tcl_SeekOld( - Tcl_Channel chan, /* The channel on which to seek. */ - int offset, /* Offset to seek to. */ - int mode) /* Relative to which location to seek? */ -{ - Tcl_WideInt wOffset, wResult; - - wOffset = Tcl_LongAsWide((long) offset); - wResult = Tcl_Seek(chan, wOffset, mode); - return (int) Tcl_WideAsLong(wResult); -} - -int -Tcl_TellOld( - Tcl_Channel chan) /* The channel to return pos for. */ -{ - Tcl_WideInt wResult = Tcl_Tell(chan); - - return (int) Tcl_WideAsLong(wResult); -} - -/* - *--------------------------------------------------------------------------- - * * Tcl_TruncateChannel -- * * Truncate a channel to the given length. diff --git a/generic/tclInt.h b/generic/tclInt.h index 8516385..5074378 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3219,9 +3219,11 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +#ifndef TCL_NO_DEPRECATED MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +#endif MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); diff --git a/generic/tclResult.c b/generic/tclResult.c index 9d0714c..6346636 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -27,7 +27,9 @@ enum returnKeys { static Tcl_Obj ** GetKeys(void); static void ReleaseKeys(ClientData clientData); static void ResetObjResult(Interp *iPtr); +#ifndef TCL_NO_DEPRECATED static void SetupAppendBuffer(Interp *iPtr, int newSpace); +#endif /* !TCL_NO_DEPRECATED */ /* * This structure is used to take a snapshot of the interpreter state in @@ -35,7 +37,7 @@ static void SetupAppendBuffer(Interp *iPtr, int newSpace); * then back up to the result or the error that was previously in progress. */ -typedef struct InterpState { +typedef struct { int status; /* return code status */ int flags; /* Each remaining field saves the */ int returnLevel; /* corresponding field of the Interp */ @@ -407,6 +409,7 @@ Tcl_DiscardResult( *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED void Tcl_SetResult( Tcl_Interp *interp, /* Interpreter with which to associate the @@ -461,6 +464,7 @@ Tcl_SetResult( ResetObjResult(iPtr); } +#endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -483,18 +487,21 @@ const char * Tcl_GetStringResult( register Tcl_Interp *interp)/* Interpreter whose result to return. */ { + Interp *iPtr = (Interp *) interp; +#ifdef TCL_NO_DEPRECATED + return Tcl_GetString(iPtr->objResultPtr); +#else /* * If the string result is empty, move the object result to the string * result, then reset the object result. */ - Interp *iPtr = (Interp *) interp; - if (*(iPtr->result) == 0) { Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), TCL_VOLATILE); } return iPtr->result; +#endif } /* @@ -536,6 +543,7 @@ Tcl_SetObjResult( TclDecrRefCount(oldObjResult); +#ifndef TCL_NO_DEPRECATED /* * Reset the string result since we just set the result object. */ @@ -550,6 +558,7 @@ Tcl_SetObjResult( } iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; +#endif } /* @@ -578,6 +587,7 @@ Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { register Interp *iPtr = (Interp *) interp; +#ifndef TCL_NO_DEPRECATED Tcl_Obj *objResultPtr; int length; @@ -604,6 +614,7 @@ Tcl_GetObjResult( iPtr->result = iPtr->resultSpace; iPtr->result[0] = 0; } +#endif /* !TCL_NO_DEPRECATED */ return iPtr->objResultPtr; } @@ -722,6 +733,21 @@ Tcl_AppendElement( * to result. */ { Interp *iPtr = (Interp *) interp; +#ifdef TCL_NO_DEPRECATED + Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1); + Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); + const char *bytes; + + if (Tcl_IsShared(iPtr->objResultPtr)) { + Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr)); + } + bytes = TclGetString(iPtr->objResultPtr); + if (TclNeedSpace(bytes, bytes+iPtr->objResultPtr->length)) { + Tcl_AppendToObj(iPtr->objResultPtr, " ", 1); + } + Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); + Tcl_DecrRefCount(listPtr); +#else char *dst; int size; int flags; @@ -765,6 +791,7 @@ Tcl_AppendElement( flags |= TCL_DONT_QUOTE_HASH; } iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags); +#endif /* !TCL_NO_DEPRECATED */ } /* @@ -786,6 +813,7 @@ Tcl_AppendElement( *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED static void SetupAppendBuffer( Interp *iPtr, /* Interpreter whose result is being set up. */ @@ -846,6 +874,7 @@ SetupAppendBuffer( Tcl_FreeResult((Tcl_Interp *) iPtr); iPtr->result = iPtr->appendResult; } +#endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -875,6 +904,7 @@ Tcl_FreeResult( { register Interp *iPtr = (Interp *) interp; +#ifndef TCL_NO_DEPRECATED if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); @@ -884,6 +914,7 @@ Tcl_FreeResult( iPtr->freeProc = 0; } +#endif /* !TCL_NO_DEPRECATED */ ResetObjResult(iPtr); } @@ -913,6 +944,7 @@ Tcl_ResetResult( register Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); +#ifndef TCL_NO_DEPRECATED if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); @@ -923,6 +955,7 @@ Tcl_ResetResult( } iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; +#endif /* !TCL_NO_DEPRECATED */ if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { @@ -1276,10 +1309,8 @@ TclProcessReturn( Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], &valuePtr); if (valuePtr != NULL) { - int infoLen; - - (void) TclGetStringFromObj(valuePtr, &infoLen); - if (infoLen) { + (void) TclGetString(valuePtr); + if (valuePtr->length) { iPtr->errorInfo = valuePtr; Tcl_IncrRefCount(iPtr->errorInfo); iPtr->flags |= ERR_ALREADY_LOGGED; @@ -1382,13 +1413,11 @@ TclMergeReturnOptions( Tcl_Obj **keys = GetKeys(); for (; objc > 1; objv += 2, objc -= 2) { - int optLen; - const char *opt = TclGetStringFromObj(objv[0], &optLen); - int compareLen; - const char *compare = - TclGetStringFromObj(keys[KEY_OPTIONS], &compareLen); + const char *opt = TclGetString(objv[0]); + const char *compare = TclGetString(keys[KEY_OPTIONS]); - if ((optLen == compareLen) && (memcmp(opt, compare, optLen) == 0)) { + if ((objv[0]->length == keys[KEY_OPTIONS]->length) + && (memcmp(opt, compare, objv[0]->length) == 0)) { Tcl_DictSearch search; int done = 0; Tcl_Obj *keyPtr; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 23da6dc..561b9dd 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -290,10 +290,47 @@ static int formatInt(char *buffer, int n){ #endif #else /* UNIX and MAC */ -# define TclpLocaltime_unix TclpLocaltime -# define TclpGmtime_unix TclpGmtime +# ifdef TCL_NO_DEPRECATED +# define TclpLocaltime_unix 0 +# define TclpGmtime_unix 0 +# else +# define TclpLocaltime_unix TclpLocaltime +# define TclpGmtime_unix TclpGmtime +# endif #endif +#ifdef TCL_NO_DEPRECATED +# define Tcl_SeekOld 0 +# define Tcl_TellOld 0 +# undef Tcl_SetResult +# define Tcl_SetResult 0 +#else /* TCL_NO_DEPRECATED */ +# define Tcl_SeekOld seekOld +# define Tcl_TellOld tellOld + +static int +seekOld( + Tcl_Channel chan, /* The channel on which to seek. */ + int offset, /* Offset to seek to. */ + int mode) /* Relative to which location to seek? */ +{ + Tcl_WideInt wOffset, wResult; + + wOffset = Tcl_LongAsWide((long) offset); + wResult = Tcl_Seek(chan, wOffset, mode); + return (int) Tcl_WideAsLong(wResult); +} + +static int +tellOld( + Tcl_Channel chan) /* The channel to return pos for. */ +{ + Tcl_WideInt wResult = Tcl_Tell(chan); + + return (int) Tcl_WideAsLong(wResult); +} +#endif /* !TCL_NO_DEPRECATED */ + /* * WARNING: The contents of this file is automatically generated by the * tools/genStubs.tcl script. Any modifications to the function declarations diff --git a/generic/tclTest.c b/generic/tclTest.c index faecbc6..a9dc1ca 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -290,12 +290,14 @@ static int TestlinkCmd(ClientData dummy, static int TestlocaleCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +#ifndef TCL_NO_DEPRECATED static int TestMathFunc(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr); static int TestMathFunc2(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr); +#endif /* TCL_NO_DEPRECATED */ static int TestmainthreadCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetmainloopCmd(ClientData dummy, @@ -329,12 +331,10 @@ static int TestreturnObjCmd(ClientData dummy, Tcl_Obj *const objv[]); static void TestregexpXflags(const char *string, int length, int *cflagsPtr, int *eflagsPtr); -#ifndef TCL_NO_DEPRECATED static int TestsaveresultCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestsaveresultFree(char *blockPtr); -#endif /* TCL_NO_DEPRECATED */ static int TestsetassocdataCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetCmd(ClientData dummy, @@ -555,7 +555,7 @@ Tcltest_Init( } /* TIP #268: Full patchlevel instead of just major.minor */ - if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) { + if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) { return TCL_ERROR; } @@ -658,10 +658,8 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, NULL, NULL); -#ifndef TCL_NO_DEPRECATED Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, NULL, NULL); -#endif /* TCL_NO_DEPRECATED */ Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd, @@ -3341,6 +3339,7 @@ TestlocaleCmd( */ /* ARGSUSED */ +#ifndef TCL_NO_DEPRECATED static int TestMathFunc( ClientData clientData, /* Integer value to return. */ @@ -3460,6 +3459,7 @@ TestMathFunc2( } return result; } +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -5144,7 +5144,6 @@ Testset2Cmd( } } -#ifndef TCL_NO_DEPRECATED /* *---------------------------------------------------------------------- * @@ -5197,6 +5196,7 @@ TestsaveresultCmd( return TCL_ERROR; } + freeCount = 0; objPtr = NULL; /* Lint. */ switch ((enum options) index) { case RESULT_SMALL: @@ -5221,7 +5221,6 @@ TestsaveresultCmd( break; } - freeCount = 0; Tcl_SaveResult(interp, &state); if (((enum options) index) == RESULT_OBJECT) { @@ -5239,11 +5238,9 @@ TestsaveresultCmd( switch ((enum options) index) { case RESULT_DYNAMIC: { - int present = iPtr->freeProc == TestsaveresultFree; - int called = freeCount; + int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount; - Tcl_AppendElement(interp, called ? "called" : "notCalled"); - Tcl_AppendElement(interp, present ? "present" : "missing"); + Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak"); break; } case RESULT_OBJECT: @@ -5278,7 +5275,6 @@ TestsaveresultFree( { freeCount++; } -#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 531f386..ba709cc 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2894,7 +2894,6 @@ Tcl_DStringResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the * result of interp. */ { - Tcl_ResetResult(interp); Tcl_SetObjResult(interp, TclDStringToObj(dsPtr)); } @@ -2924,6 +2923,14 @@ Tcl_DStringGetResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { +#ifdef TCL_NO_DEPRECATED + Tcl_Obj *obj = Tcl_GetObjResult(interp); + const char *bytes = TclGetString(obj); + + Tcl_DStringFree(dsPtr); + Tcl_DStringAppend(dsPtr, bytes, obj->length); + Tcl_ResetResult(interp); +#else Interp *iPtr = (Interp *) interp; if (dsPtr->string != dsPtr->staticSpace) { @@ -2932,7 +2939,7 @@ Tcl_DStringGetResult( /* * Do more efficient transfer when we know the result is a Tcl_Obj. When - * there's no st`ring result, we only have to deal with two cases: + * there's no string result, we only have to deal with two cases: * * 1. When the string rep is the empty string, when we don't copy but * instead use the staticSpace in the DString to hold an empty string. @@ -2995,6 +3002,7 @@ Tcl_DStringGetResult( iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; +#endif /* !TCL_NO_DEPRECATED */ } /* @@ -3576,7 +3584,7 @@ TclGetIntForIndex( int *indexPtr) /* Location filled in with an integer * representing an index. */ { - int length; + size_t length; char *opPtr; const char *bytes; @@ -3594,7 +3602,8 @@ TclGetIntForIndex( return TCL_OK; } - bytes = TclGetStringFromObj(objPtr, &length); + bytes = TclGetString(objPtr); + length = objPtr->length; /* * Leading whitespace is acceptable in an index. diff --git a/tests/case.test b/tests/case.test index 6d63cea..d7558a9 100644 --- a/tests/case.test +++ b/tests/case.test @@ -11,6 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. +if {![llength [info commands case]]} { + # No "case" command? So no need to test + return +} + if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* diff --git a/tests/result.test b/tests/result.test index 9e8a66b..859e546 100644 --- a/tests/result.test +++ b/tests/result.test @@ -31,7 +31,7 @@ test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} { } {append result} test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 0 -} {dynamic result notCalled present} +} {dynamic result presentOrFreed} test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 0 } {object result same} @@ -43,7 +43,7 @@ test result-1.6 {Tcl_SaveInterpResult} {testsaveresult} { } {42} test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 1 -} {42 called missing} +} {42 presentOrFreed} test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 1 } {42 different} diff --git a/tools/configure b/tools/configure index 7c4d3db..5903cc8 100755 --- a/tools/configure +++ b/tools/configure @@ -1681,7 +1681,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- -DEF_VER=8.6 +DEF_VER=8.7 # Check whether --with-tcl was given. -- cgit v0.12 From 368a29cbf01f4aa930631726ce71aafe9c853f12 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 27 Jan 2017 14:31:12 +0000 Subject: Some code cleanup: More internal use of size_t, less type casts (because of this). No functional changes. --- generic/tclLink.c | 66 ++++++++++++++++++++++--------------------------------- generic/tclObj.c | 17 +++++++------- generic/tclProc.c | 10 ++++----- 3 files changed, 40 insertions(+), 53 deletions(-) diff --git a/generic/tclLink.c b/generic/tclLink.c index 2ead6df..46471f5 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -67,10 +67,8 @@ typedef struct Link { static char * LinkTraceProc(ClientData clientData,Tcl_Interp *interp, const char *name1, const char *name2, int flags); static Tcl_Obj * ObjValue(Link *linkPtr); -static int GetInvalidIntFromObj(Tcl_Obj *objPtr, - int *intPtr); -static int GetInvalidDoubleFromObj(Tcl_Obj *objPtr, - double *doublePtr); +static int GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr); +static int GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr); /* * Convenience macro for accessing the value of the C variable pointed to by a @@ -263,7 +261,8 @@ LinkTraceProc( int flags) /* Miscellaneous additional information. */ { Link *linkPtr = clientData; - int changed, valueLength; + int changed; + size_t valueLength; const char *value; char **pp; Tcl_Obj *valueObj; @@ -384,8 +383,7 @@ LinkTraceProc( case TCL_LINK_INT: if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK) { - if (GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) - != TCL_OK) { + if (GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have integer value"; @@ -397,8 +395,7 @@ LinkTraceProc( case TCL_LINK_WIDE_INT: if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w) != TCL_OK) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { + if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have integer value"; @@ -441,8 +438,7 @@ LinkTraceProc( case TCL_LINK_CHAR: if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK || valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { + if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have char value"; @@ -455,8 +451,7 @@ LinkTraceProc( case TCL_LINK_UCHAR: if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK || valueInt < 0 || valueInt > UCHAR_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { + if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have unsigned char value"; @@ -469,8 +464,7 @@ LinkTraceProc( case TCL_LINK_SHORT: if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK || valueInt < SHRT_MIN || valueInt > SHRT_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { + if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have short value"; @@ -483,8 +477,7 @@ LinkTraceProc( case TCL_LINK_USHORT: if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK || valueInt < 0 || valueInt > USHRT_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { + if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have unsigned short value"; @@ -497,8 +490,7 @@ LinkTraceProc( case TCL_LINK_UINT: if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK || valueWide < 0 || valueWide > UINT_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { + if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have unsigned int value"; @@ -513,8 +505,7 @@ LinkTraceProc( case TCL_LINK_LONG: if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK || valueWide < LONG_MIN || valueWide > LONG_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { + if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have long value"; @@ -529,8 +520,7 @@ LinkTraceProc( case TCL_LINK_ULONG: if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK || valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { + if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have unsigned long value"; @@ -547,8 +537,7 @@ LinkTraceProc( * FIXME: represent as a bignum. */ if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { + if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have unsigned wide int value"; @@ -575,12 +564,12 @@ LinkTraceProc( break; case TCL_LINK_STRING: - value = TclGetStringFromObj(valueObj, &valueLength); - valueLength++; + value = TclGetString(valueObj); + valueLength = valueObj->length + 1; pp = (char **) linkPtr->addr; *pp = ckrealloc(*pp, valueLength); - memcpy(*pp, value, (unsigned) valueLength); + memcpy(*pp, value, valueLength); break; default: @@ -688,17 +677,16 @@ static Tcl_ObjType invalidRealType = { static int SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) { - int length; const char *str; const char *endPtr; - str = TclGetStringFromObj(objPtr, &length); - if ((length == 1) && (str[0] == '.')){ + str = TclGetString(objPtr); + if ((objPtr->length == 1) && (str[0] == '.')){ objPtr->typePtr = &invalidRealType; objPtr->internalRep.doubleValue = 0.0; return TCL_OK; } - if (TclParseNumber(NULL, objPtr, NULL, str, length, &endPtr, + if (TclParseNumber(NULL, objPtr, NULL, str, objPtr->length, &endPtr, TCL_PARSE_DECIMAL_ONLY) == TCL_OK) { /* If number is followed by [eE][+-]?, then it is an invalid * double, but it could be the start of a valid double. */ @@ -708,7 +696,7 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) { if (*endPtr == 0) { double doubleValue = 0.0; Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue); - if (objPtr->typePtr->freeIntRepProc) objPtr->typePtr->freeIntRepProc(objPtr); + TclFreeIntRep(objPtr); objPtr->typePtr = &invalidRealType; objPtr->internalRep.doubleValue = doubleValue; return TCL_OK; @@ -726,17 +714,15 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) { * (upperand lowercase). See bug [39f6304c2e]. */ int -GetInvalidIntFromObj(Tcl_Obj *objPtr, - int *intPtr) +GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr) { - int length; - const char *str = TclGetStringFromObj(objPtr, &length); + const char *str = TclGetString(objPtr); - if ((length == 1) && strchr("+-", str[0])) { + if ((objPtr->length == 1) && strchr("+-", str[0])) { *intPtr = (str[0] == '+'); return TCL_OK; - } else if ((length == 0) || - ((length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) { + } else if ((objPtr->length == 0) || + ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) { *intPtr = 0; return TCL_OK; } diff --git a/generic/tclObj.c b/generic/tclObj.c index df900ce..d0f7480 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2004,9 +2004,10 @@ static int ParseBoolean( register Tcl_Obj *objPtr) /* The object to parse/convert. */ { - int i, length, newBool; + int newBool; char lowerCase[6]; - const char *str = TclGetStringFromObj(objPtr, &length); + const char *str = TclGetString(objPtr); + size_t i, length = objPtr->length; if ((length == 0) || (length > 5)) { /* @@ -2058,25 +2059,25 @@ ParseBoolean( /* * Checking the 'y' is redundant, but makes the code clearer. */ - if (strncmp(lowerCase, "yes", (size_t) length) == 0) { + if (strncmp(lowerCase, "yes", length) == 0) { newBool = 1; goto goodBoolean; } return TCL_ERROR; case 'n': - if (strncmp(lowerCase, "no", (size_t) length) == 0) { + if (strncmp(lowerCase, "no", length) == 0) { newBool = 0; goto goodBoolean; } return TCL_ERROR; case 't': - if (strncmp(lowerCase, "true", (size_t) length) == 0) { + if (strncmp(lowerCase, "true", length) == 0) { newBool = 1; goto goodBoolean; } return TCL_ERROR; case 'f': - if (strncmp(lowerCase, "false", (size_t) length) == 0) { + if (strncmp(lowerCase, "false", length) == 0) { newBool = 0; goto goodBoolean; } @@ -2085,10 +2086,10 @@ ParseBoolean( if (length < 2) { return TCL_ERROR; } - if (strncmp(lowerCase, "on", (size_t) length) == 0) { + if (strncmp(lowerCase, "on", length) == 0) { newBool = 1; goto goodBoolean; - } else if (strncmp(lowerCase, "off", (size_t) length) == 0) { + } else if (strncmp(lowerCase, "off", length) == 0) { newBool = 0; goto goodBoolean; } diff --git a/generic/tclProc.c b/generic/tclProc.c index bed520a..373192c 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -500,7 +500,8 @@ TclCreateProc( } for (i = 0; i < numArgs; i++) { - int fieldCount, nameLength, valueLength; + int fieldCount, nameLength; + size_t valueLength; const char **fieldValues; /* @@ -602,12 +603,11 @@ TclCreateProc( */ if (localPtr->defValuePtr != NULL) { - int tmpLength; - const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr, - &tmpLength); + const char *tmpPtr = TclGetString(localPtr->defValuePtr); + size_t tmpLength = localPtr->defValuePtr->length; if ((valueLength != tmpLength) || - strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) { + strncmp(fieldValues[1], tmpPtr, tmpLength)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "procedure \"%s\": formal parameter \"%s\" has " "default value inconsistent with precompiled body", -- cgit v0.12 From 1c6496c269fc6be350eae56e9b2351ce6e7e6dac Mon Sep 17 00:00:00 2001 From: ashok Date: Sat, 28 Jan 2017 06:38:22 +0000 Subject: Added assoc, ftype and move as auto_execok shell built-ins on Windows. --- library/init.tcl | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/library/init.tcl b/library/init.tcl index 544ea77..5a9e87c 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -636,8 +636,9 @@ proc auto_execok name { } set auto_execs($name) "" - set shellBuiltins [list cls copy date del dir echo erase md mkdir \ - mklink rd ren rename rmdir start time type ver vol] + set shellBuiltins [list assoc cls copy date del dir echo erase ftype \ + md mkdir mklink move rd ren rename rmdir start \ + time type ver vol] if {[info exists env(PATHEXT)]} { # Add an initial ; to have the {} extension check first. set execExtensions [split ";$env(PATHEXT)" ";"] -- cgit v0.12 From a5fff7a94743517ada1b332a259ccfa63bb89570 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 31 Jan 2017 13:15:40 +0000 Subject: Update documentation on recent changes in Tcl_LinkVar. Don't use TCL_NO_DEPRECATED for disabling tests-cases: Those were not deprecated in 8.6 yet. Minor code clean-up. No functional changes. --- doc/LinkVar.3 | 48 ++++++++++++++++++++++++++++++++++++------------ generic/tclLink.c | 38 ++++++++++++++++++++------------------ generic/tclObj.c | 12 ++++++------ generic/tclTest.c | 14 +------------- 4 files changed, 63 insertions(+), 49 deletions(-) diff --git a/doc/LinkVar.3 b/doc/LinkVar.3 index c64720b..0b746b0 100644 --- a/doc/LinkVar.3 +++ b/doc/LinkVar.3 @@ -61,7 +61,9 @@ The C variable is of type \fBint\fR. Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetIntFromObj\fR; attempts to write non-integer values into \fIvarName\fR will be rejected with -Tcl errors. +Tcl errors. Incomplete integer representations (like the empty +string, '+', '-' or the hex/octal/binary prefix) are accepted +as if they are valid too. .TP \fBTCL_LINK_UINT\fR The C variable is of type \fBunsigned int\fR. @@ -69,14 +71,18 @@ Any value written into the Tcl variable must have a proper unsigned integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the platform's defined range for the \fBunsigned int\fR type; attempts to write non-integer values (or values outside the range) into -\fIvarName\fR will be rejected with Tcl errors. +\fIvarName\fR will be rejected with Tcl errors. Incomplete integer +representations (like the empty string, '+', '-' or the hex/octal/binary +prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_CHAR\fR The C variable is of type \fBchar\fR. Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the \fBchar\fR datatype; attempts to write non-integer or out-of-range -values into \fIvarName\fR will be rejected with Tcl errors. +values into \fIvarName\fR will be rejected with Tcl errors. Incomplete +integer representations (like the empty string, '+', '-' or the +hex/octal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_UCHAR\fR The C variable is of type \fBunsigned char\fR. @@ -84,14 +90,18 @@ Any value written into the Tcl variable must have a proper unsigned integer form acceptable to \fBTcl_GetIntFromObj\fR and in the platform's defined range for the \fBunsigned char\fR type; attempts to write non-integer values (or values outside the range) into -\fIvarName\fR will be rejected with Tcl errors. +\fIvarName\fR will be rejected with Tcl errors. Incomplete integer +representations (like the empty string, '+', '-' or the hex/octal/binary +prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_SHORT\fR The C variable is of type \fBshort\fR. Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the \fBshort\fR datatype; attempts to write non-integer or out-of-range -values into \fIvarName\fR will be rejected with Tcl errors. +values into \fIvarName\fR will be rejected with Tcl errors. Incomplete +integer representations (like the empty string, '+', '-' or the +hex/octal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_USHORT\fR The C variable is of type \fBunsigned short\fR. @@ -99,14 +109,18 @@ Any value written into the Tcl variable must have a proper unsigned integer form acceptable to \fBTcl_GetIntFromObj\fR and in the platform's defined range for the \fBunsigned short\fR type; attempts to write non-integer values (or values outside the range) into -\fIvarName\fR will be rejected with Tcl errors. +\fIvarName\fR will be rejected with Tcl errors. Incomplete integer +representations (like the empty string, '+', '-' or the hex/octal/binary +prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_LONG\fR The C variable is of type \fBlong\fR. Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetLongFromObj\fR; attempts to write non-integer or out-of-range -values into \fIvarName\fR will be rejected with Tcl errors. +values into \fIvarName\fR will be rejected with Tcl errors. Incomplete +integer representations (like the empty string, '+', '-' or the +hex/octal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_ULONG\fR The C variable is of type \fBunsigned long\fR. @@ -114,14 +128,18 @@ Any value written into the Tcl variable must have a proper unsigned integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the platform's defined range for the \fBunsigned long\fR type; attempts to write non-integer values (or values outside the range) into -\fIvarName\fR will be rejected with Tcl errors. +\fIvarName\fR will be rejected with Tcl errors. Incomplete integer +representations (like the empty string, '+', '-' or the hex/octal/binary +prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_DOUBLE\fR The C variable is of type \fBdouble\fR. Any value written into the Tcl variable must have a proper real form acceptable to \fBTcl_GetDoubleFromObj\fR; attempts to write non-real values into \fIvarName\fR will be rejected with -Tcl errors. +Tcl errors. Incomplete integer or real representations (like the +empty string, '.', '+', '-' or the hex/octal/binary prefix) are +accepted as if they are valid too. .TP \fBTCL_LINK_FLOAT\fR The C variable is of type \fBfloat\fR. @@ -129,7 +147,9 @@ Any value written into the Tcl variable must have a proper real form acceptable to \fBTcl_GetDoubleFromObj\fR and must be within the range acceptable for a \fBfloat\fR; attempts to write non-real values (or values outside the range) into -\fIvarName\fR will be rejected with Tcl errors. +\fIvarName\fR will be rejected with Tcl errors. Incomplete integer +or real representations (like the empty string, '.', '+', '-' or +the hex/octal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_WIDE_INT\fR The C variable is of type \fBTcl_WideInt\fR (which is an integer type @@ -137,7 +157,9 @@ at least 64-bits wide on all platforms that can support it.) Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetWideIntFromObj\fR; attempts to write non-integer values into \fIvarName\fR will be rejected with -Tcl errors. +Tcl errors. Incomplete integer representations (like the empty +string, '+', '-' or the hex/octal/binary prefix) are accepted +as if they are valid too. .TP \fBTCL_LINK_WIDE_UINT\fR The C variable is of type \fBTcl_WideUInt\fR (which is an unsigned @@ -148,7 +170,9 @@ integer form acceptable to \fBTcl_GetWideIntFromObj\fR (it will be cast to unsigned); .\" FIXME! Use bignums instead. attempts to write non-integer values into \fIvarName\fR will be -rejected with Tcl errors. +rejected with Tcl errors. Incomplete integer representations (like +the empty string, '+', '-' or the hex/octal/binary prefix) are accepted +as if they are valid too. .TP \fBTCL_LINK_BOOLEAN\fR The C variable is of type \fBint\fR. diff --git a/generic/tclLink.c b/generic/tclLink.c index 6741377..f8f2342 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -575,7 +575,7 @@ LinkTraceProc( break; case TCL_LINK_STRING: - value = Tcl_GetStringFromObj(valueObj, &valueLength); + value = TclGetStringFromObj(valueObj, &valueLength); valueLength++; pp = (char **) linkPtr->addr; @@ -722,23 +722,22 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) { /* * This function checks for integer representations, which are valid * when linking with C variables, but which are invalid in other - * contexts in Tcl. Handled are "", "+", "-", "0x", "0b" and "0o" + * contexts in Tcl. Handled are "+", "-", "", "0x", "0b" and "0o" * (upperand lowercase). See bug [39f6304c2e]. */ int GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr) { - int length; - const char *str = TclGetStringFromObj(objPtr, &length); + const char *str = TclGetString(objPtr); - if ((length == 1) && strchr("+-", str[0])) { - *intPtr = (str[0] == '+'); - return TCL_OK; - } else if ((length == 0) || - ((length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) { + if ((objPtr->length == 0) || + ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) { *intPtr = 0; return TCL_OK; + } else if ((objPtr->length == 1) && strchr("+-", str[0])) { + *intPtr = (str[0] == '+'); + return TCL_OK; } return TCL_ERROR; } @@ -746,25 +745,28 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr, /* * This function checks for double representations, which are valid * when linking with C variables, but which are invalid in other - * contexts in Tcl. Handled are ".", "+", "-", "0x", "0b" and "0o" + * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o" * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e]. */ int GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr) { - int intValue, result; + int intValue; - if ((objPtr->typePtr == &invalidRealType) || - (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK)) { - *doublePtr = objPtr->internalRep.doubleValue; - return TCL_OK; + if (objPtr->typePtr == &invalidRealType) { + goto gotdouble; } - result = GetInvalidIntFromObj(objPtr, &intValue); - if (result == TCL_OK) { + if (GetInvalidIntFromObj(objPtr, &intValue) == TCL_OK) { *doublePtr = (double) intValue; + return TCL_OK; + } + if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) { + gotdouble: + *doublePtr = objPtr->internalRep.doubleValue; + return TCL_OK; } - return result; + return TCL_ERROR; } /* diff --git a/generic/tclObj.c b/generic/tclObj.c index 45f79e4..a346987 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -663,7 +663,7 @@ TclContinuationsEnterDerived( * better way which doesn't shimmer?) */ - Tcl_GetStringFromObj(objPtr, &length); + TclGetStringFromObj(objPtr, &length); end = start + length; /* First char after the word */ /* @@ -1989,7 +1989,7 @@ TclSetBooleanFromAny( badBoolean: if (interp != NULL) { int length; - const char *str = Tcl_GetStringFromObj(objPtr, &length); + const char *str = TclGetStringFromObj(objPtr, &length); Tcl_Obj *msg; TclNewLiteralStringObj(msg, "expected boolean value but got \""); @@ -2785,7 +2785,7 @@ Tcl_GetLongFromObj( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", - Tcl_GetString(objPtr))); + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; @@ -3086,7 +3086,7 @@ Tcl_GetWideIntFromObj( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", - Tcl_GetString(objPtr))); + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; @@ -3415,7 +3415,7 @@ GetBignumFromObj( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", - Tcl_GetString(objPtr))); + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; @@ -3965,7 +3965,7 @@ TclCompareObjKeys( Tcl_Obj *objPtr1 = keyPtr; Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue; register const char *p1, *p2; - register int l1, l2; + register size_t l1, l2; /* * If the object pointers are the same then they match. diff --git a/generic/tclTest.c b/generic/tclTest.c index 568dd01..f2dbfc9 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -331,12 +331,10 @@ static int TestreturnObjCmd(ClientData dummy, Tcl_Obj *const objv[]); static void TestregexpXflags(const char *string, int length, int *cflagsPtr, int *eflagsPtr); -#ifndef TCL_NO_DEPRECATED static int TestsaveresultCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestsaveresultFree(char *blockPtr); -#endif /* TCL_NO_DEPRECATED */ static int TestsetassocdataCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetCmd(ClientData dummy, @@ -534,9 +532,7 @@ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { -#ifndef TCL_NO_DEPRECATED Tcl_ValueType t3ArgTypes[2]; -#endif /* TCL_NO_DEPRECATED */ Tcl_Obj *listPtr; Tcl_Obj **objv; @@ -656,10 +652,8 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, NULL, NULL); -#ifndef TCL_NO_DEPRECATED Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, NULL, NULL); -#endif /* TCL_NO_DEPRECATED */ Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd, @@ -681,10 +675,8 @@ Tcltest_Init( Tcl_CreateCommand(interp, "testtranslatefilename", TesttranslatefilenameCmd, NULL, NULL); Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL); -#ifndef TCL_NO_DEPRECATED Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123); Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345); -#endif /* TCL_NO_DEPRECATED */ Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd, @@ -695,12 +687,10 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, (ClientData) 0, NULL); #endif -#ifndef TCL_NO_DEPRECATED t3ArgTypes[0] = TCL_EITHER; t3ArgTypes[1] = TCL_EITHER; Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, NULL); -#endif /* TCL_NO_DEPRECATED */ Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind, NULL, NULL); @@ -4570,7 +4560,7 @@ TestpanicCmd( int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - const char *argString; + char *argString; /* * Put the arguments into a var args structure @@ -5075,7 +5065,6 @@ Testset2Cmd( } } -#ifndef TCL_NO_DEPRECATED /* *---------------------------------------------------------------------- * @@ -5209,7 +5198,6 @@ TestsaveresultFree( { freeCount++; } -#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- -- cgit v0.12 From 304de510732b5bf301c6d97ca26f876dca26886e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 1 Feb 2017 14:42:48 +0000 Subject: Fix [d0f7ba56f0e8f93b7efb5b09ebc30a824bdd577a|d0f7ba56f0]: INST_EQ first-argument NaN shortcut is too aggressive --- generic/tclExecute.c | 22 ++++------------------ tests/expr.test | 9 +++++++++ 2 files changed, 13 insertions(+), 18 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index bfb9d17..608b420 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4496,16 +4496,17 @@ TclExecuteByteCode( Tcl_WideInt w1, w2; #endif - if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) { + if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK + || GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) { /* * At least one non-numeric argument - compare as strings. */ goto stringCompare; } - if (type1 == TCL_NUMBER_NAN) { + if (type1 == TCL_NUMBER_NAN || type2 == TCL_NUMBER_NAN) { /* - * NaN first arg: NaN != to everything, other compares are false. + * NaN arg: NaN != to everything, other compares are false. */ iResult = (*pc == INST_NEQ); @@ -4515,21 +4516,6 @@ TclExecuteByteCode( compare = MP_EQ; goto convertComparison; } - if (GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) { - /* - * At least one non-numeric argument - compare as strings. - */ - - goto stringCompare; - } - if (type2 == TCL_NUMBER_NAN) { - /* - * NaN 2nd arg: NaN != to everything, other compares are false. - */ - - iResult = (*pc == INST_NEQ); - goto foundResult; - } switch (type1) { case TCL_NUMBER_LONG: l1 = *((const long *)ptr1); diff --git a/tests/expr.test b/tests/expr.test index bd5ed8f..3a69407 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -910,6 +910,15 @@ test expr-22.9 {non-numeric floats: shared object equality and NaN} { set x NaN expr {$x == $x} } 0 +# Make sure [Bug d0f7ba56f0] stays fixed. +test expr-22.10 {non-numeric arguments: equality and NaN} { + set x NaN + expr {$x > "Gran"} +} 1 +test expr-22.11 {non-numeric arguments: equality and NaN} { + set x NaN + expr {"Gran" < $x} +} 1 # Tests for exponentiation handling test expr-23.1 {CompileExponentialExpr: just exponential expr} {expr 4**2} 16 -- cgit v0.12 From e2779b6b41c0ecc07005f1da41c7b6aa5895ed36 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 3 Feb 2017 11:47:02 +0000 Subject: In TclGetNumberFromObj() macro (tclExecute.c): Don't fill in type if TCL_ERROR is returned: The caller doesn't do anything with this. Don't access (non-const) variable tclEmptyStringRep any more, use its value (&tclEmptyString) directly. Only keep it in tclPkg.c, for error checking. --- generic/tclBasic.c | 2 +- generic/tclDictObj.c | 2 +- generic/tclExecute.c | 4 ++-- generic/tclInt.h | 9 ++++----- generic/tclListObj.c | 16 ++++++++-------- generic/tclObj.c | 5 ++--- generic/tclPathObj.c | 2 +- generic/tclPkg.c | 2 ++ generic/tclResult.c | 4 ++-- generic/tclStringObj.c | 12 ++++++------ generic/tclUtil.c | 6 +++--- unix/tclUnixSock.c | 2 +- 12 files changed, 33 insertions(+), 33 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b4d0a7b..63c5590 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6055,7 +6055,7 @@ TclNREvalObjEx( TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, objPtr, NULL); - ListObjGetElements(listPtr, objc, objv); + TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); } diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 1115999..970978f 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -506,7 +506,7 @@ UpdateStringOfDict( /* Handle empty list case first, simplifies what follows */ if (numElems == 0) { - dictPtr->bytes = tclEmptyStringRep; + dictPtr->bytes = &tclEmptyString; dictPtr->length = 0; return; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index c0dc9c0..c244b08 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -512,7 +512,7 @@ VarHashCreateVar( (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \ ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \ (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \ - ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \ + ? TCL_ERROR : \ TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr))) #else /* !TCL_WIDE_INT_IS_LONG */ #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ @@ -532,7 +532,7 @@ VarHashCreateVar( (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \ ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \ (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \ - ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \ + ? TCL_ERROR : \ TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr))) #endif /* TCL_WIDE_INT_IS_LONG */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 5074378..4b87962 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2745,7 +2745,6 @@ MODULE_SCOPE long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS]; * shared by all new objects allocated by Tcl_NewObj. */ -MODULE_SCOPE char * tclEmptyStringRep; MODULE_SCOPE char tclEmptyString; /* @@ -4066,7 +4065,7 @@ typedef const char *TclDTraceStr; TclIncrObjsAllocated(); \ TclAllocObjStorage(objPtr); \ (objPtr)->refCount = 0; \ - (objPtr)->bytes = tclEmptyStringRep; \ + (objPtr)->bytes = &tclEmptyString; \ (objPtr)->length = 0; \ (objPtr)->typePtr = NULL; \ TCL_DTRACE_OBJ_CREATE(objPtr) @@ -4083,7 +4082,7 @@ typedef const char *TclDTraceStr; if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ TCL_DTRACE_OBJ_FREE(objPtr); \ if ((objPtr)->bytes \ - && ((objPtr)->bytes != tclEmptyStringRep)) { \ + && ((objPtr)->bytes != &tclEmptyString)) { \ ckfree((objPtr)->bytes); \ } \ (objPtr)->length = -1; \ @@ -4244,7 +4243,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, #define TclInitStringRep(objPtr, bytePtr, len) \ if ((len) == 0) { \ - (objPtr)->bytes = tclEmptyStringRep; \ + (objPtr)->bytes = &tclEmptyString; \ (objPtr)->length = 0; \ } else { \ (objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \ @@ -4302,7 +4301,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, #define TclInvalidateStringRep(objPtr) \ if ((objPtr)->bytes != NULL) { \ - if ((objPtr)->bytes != tclEmptyStringRep) { \ + if ((objPtr)->bytes != &tclEmptyString) { \ ckfree((objPtr)->bytes); \ } \ (objPtr)->bytes = NULL; \ diff --git a/generic/tclListObj.c b/generic/tclListObj.c index c9fd333..11374cc 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -374,7 +374,7 @@ Tcl_SetListObj( listRepPtr = NewListIntRep(objc, objv, 1); ListSetIntRep(objPtr, listRepPtr); } else { - objPtr->bytes = tclEmptyStringRep; + objPtr->bytes = &tclEmptyString; objPtr->length = 0; } } @@ -465,7 +465,7 @@ Tcl_ListObjGetElements( if (listPtr->typePtr != &tclListType) { int result; - if (listPtr->bytes == tclEmptyStringRep) { + if (listPtr->bytes == &tclEmptyString) { *objcPtr = 0; *objvPtr = NULL; return TCL_OK; @@ -575,7 +575,7 @@ Tcl_ListObjAppendElement( if (listPtr->typePtr != &tclListType) { int result; - if (listPtr->bytes == tclEmptyStringRep) { + if (listPtr->bytes == &tclEmptyString) { Tcl_SetListObj(listPtr, 1, &objPtr); return TCL_OK; } @@ -739,7 +739,7 @@ Tcl_ListObjIndex( if (listPtr->typePtr != &tclListType) { int result; - if (listPtr->bytes == tclEmptyStringRep) { + if (listPtr->bytes == &tclEmptyString) { *objPtrPtr = NULL; return TCL_OK; } @@ -792,7 +792,7 @@ Tcl_ListObjLength( if (listPtr->typePtr != &tclListType) { int result; - if (listPtr->bytes == tclEmptyStringRep) { + if (listPtr->bytes == &tclEmptyString) { *intPtr = 0; return TCL_OK; } @@ -863,7 +863,7 @@ Tcl_ListObjReplace( Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace"); } if (listPtr->typePtr != &tclListType) { - if (listPtr->bytes == tclEmptyStringRep) { + if (listPtr->bytes == &tclEmptyString) { if (!objc) { return TCL_OK; } @@ -1650,7 +1650,7 @@ TclListObjSetElement( if (listPtr->typePtr != &tclListType) { int result; - if (listPtr->bytes == tclEmptyStringRep) { + if (listPtr->bytes == &tclEmptyString) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); @@ -1979,7 +1979,7 @@ UpdateStringOfList( */ if (numElems == 0) { - listPtr->bytes = tclEmptyStringRep; + listPtr->bytes = &tclEmptyString; listPtr->length = 0; return; } diff --git a/generic/tclObj.c b/generic/tclObj.c index 90df579..1abbb31 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -49,7 +49,6 @@ Tcl_Mutex tclObjMutex; */ char tclEmptyString = '\0'; -char *tclEmptyStringRep = &tclEmptyString; #if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) /* @@ -1060,7 +1059,7 @@ TclDbInitNewObj( * debugging. */ { objPtr->refCount = 0; - objPtr->bytes = tclEmptyStringRep; + objPtr->bytes = &tclEmptyString; objPtr->length = 0; objPtr->typePtr = NULL; @@ -3395,7 +3394,7 @@ GetBignumFromObj( objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = NULL; if (objPtr->bytes == NULL) { - TclInitStringRep(objPtr, tclEmptyStringRep, 0); + TclInitStringRep(objPtr, &tclEmptyString, 0); } } return TCL_OK; diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 68ec2c4..0053041 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -2608,7 +2608,7 @@ UpdateStringOfFsPath( pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen); pathPtr->length = cwdLen; - copy->bytes = tclEmptyStringRep; + copy->bytes = &tclEmptyString; copy->length = 0; TclDecrRefCount(copy); } diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 42dd08d..2925c34 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -17,6 +17,8 @@ #include "tclInt.h" +MODULE_SCOPE char *tclEmptyStringRep = &tclEmptyString; + /* * Each invocation of the "package ifneeded" command creates a structure of * the following type, which is used to load the package into the interpreter diff --git a/generic/tclResult.c b/generic/tclResult.c index 6346636..ddf764b 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -1015,11 +1015,11 @@ ResetObjResult( Tcl_IncrRefCount(objResultPtr); iPtr->objResultPtr = objResultPtr; } else { - if (objResultPtr->bytes != tclEmptyStringRep) { + if (objResultPtr->bytes != &tclEmptyString) { if (objResultPtr->bytes) { ckfree(objResultPtr->bytes); } - objResultPtr->bytes = tclEmptyStringRep; + objResultPtr->bytes = &tclEmptyString; objResultPtr->length = 0; } TclFreeIntRep(objResultPtr); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index db233b3..c45baa1 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -136,7 +136,7 @@ GrowStringBuffer( char *ptr = NULL; int attempt; - if (objPtr->bytes == tclEmptyStringRep) { + if (objPtr->bytes == &tclEmptyString) { objPtr->bytes = NULL; } if (flag == 0 || stringPtr->allocated > 0) { @@ -767,7 +767,7 @@ Tcl_SetObjLength( /* * Need to enlarge the buffer. */ - if (objPtr->bytes == tclEmptyStringRep) { + if (objPtr->bytes == &tclEmptyString) { objPtr->bytes = ckalloc(length + 1); } else { objPtr->bytes = ckrealloc(objPtr->bytes, length + 1); @@ -873,7 +873,7 @@ Tcl_AttemptSetObjLength( char *newBytes; - if (objPtr->bytes == tclEmptyStringRep) { + if (objPtr->bytes == &tclEmptyString) { newBytes = attemptckalloc(length + 1); } else { newBytes = attemptckrealloc(objPtr->bytes, length + 1); @@ -1202,7 +1202,7 @@ Tcl_AppendObjToObj( * that appending nothing to anything leaves that starting anything... */ - if (appendObjPtr->bytes == tclEmptyStringRep) { + if (appendObjPtr->bytes == &tclEmptyString) { return; } @@ -1213,7 +1213,7 @@ Tcl_AppendObjToObj( * information; this is a special-case optimization only. */ - if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep) + if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString) && TclIsPureByteArray(appendObjPtr)) { /* @@ -3603,7 +3603,7 @@ UpdateStringOfString( stringPtr->allocated = 0; if (stringPtr->numChars == 0) { - TclInitStringRep(objPtr, tclEmptyStringRep, 0); + TclInitStringRep(objPtr, &tclEmptyString, 0); } else { (void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode, stringPtr->numChars); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index ba709cc..a4d523a 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1384,7 +1384,7 @@ TclConvertElement( */ if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) { - src = tclEmptyStringRep; + src = &tclEmptyString; length = 0; conversion = CONVERT_BRACE; } @@ -2954,7 +2954,7 @@ Tcl_DStringGetResult( if (!iPtr->result[0] && iPtr->objResultPtr && !Tcl_IsShared(iPtr->objResultPtr)) { - if (iPtr->objResultPtr->bytes == tclEmptyStringRep) { + if (iPtr->objResultPtr->bytes == &tclEmptyString) { dsPtr->string = dsPtr->staticSpace; dsPtr->string[0] = 0; dsPtr->length = 0; @@ -2964,7 +2964,7 @@ Tcl_DStringGetResult( dsPtr->length = iPtr->objResultPtr->length; dsPtr->spaceAvl = dsPtr->length + 1; TclFreeIntRep(iPtr->objResultPtr); - iPtr->objResultPtr->bytes = tclEmptyStringRep; + iPtr->objResultPtr->bytes = &tclEmptyString; iPtr->objResultPtr->length = 0; } return; diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 8e97543..9387d05 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -240,7 +240,7 @@ InitializeHostName( } } if (native == NULL) { - native = tclEmptyStringRep; + native = &tclEmptyString; } #else /* !NO_UNAME */ /* -- cgit v0.12 From f3ca0e45dc4faf67ceb9d9cab12b06ca7ed60a6b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 3 Feb 2017 14:29:50 +0000 Subject: Split tclEmptyStringRep declaration over two lines. Otherwise gcc warning. --- generic/tclPkg.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 2925c34..0759faa 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -17,7 +17,9 @@ #include "tclInt.h" -MODULE_SCOPE char *tclEmptyStringRep = &tclEmptyString; +MODULE_SCOPE char *tclEmptyStringRep; + +char *tclEmptyStringRep = &tclEmptyString; /* * Each invocation of the "package ifneeded" command creates a structure of -- cgit v0.12 From 02daccc325c05a024ab3845f580d7cd7e5869244 Mon Sep 17 00:00:00 2001 From: bch Date: Mon, 6 Feb 2017 21:54:30 +0000 Subject: s/then/than/ in Eval.3 manpage --- doc/Eval.3 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/Eval.3 b/doc/Eval.3 index 8661923..191bace 100644 --- a/doc/Eval.3 +++ b/doc/Eval.3 @@ -205,7 +205,7 @@ and sets \fIinterp\fR's result to an error message indicating that the \fBreturn\fR, \fBbreak\fR, or \fBcontinue\fR command was invoked in an inappropriate place. This means that top-level applications should never see a return code -from \fBTcl_EvalObjEx\fR other then \fBTCL_OK\fR or \fBTCL_ERROR\fR. +from \fBTcl_EvalObjEx\fR other than \fBTCL_OK\fR or \fBTCL_ERROR\fR. .SH KEYWORDS execute, file, global, result, script, value -- cgit v0.12 From 59d58114edd5bd6eef5c80dc0e3a9cf1d59938a1 Mon Sep 17 00:00:00 2001 From: bch Date: Mon, 6 Feb 2017 21:58:48 +0000 Subject: cherrypick typo fix. --- doc/Eval.3 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/Eval.3 b/doc/Eval.3 index 8661923..191bace 100644 --- a/doc/Eval.3 +++ b/doc/Eval.3 @@ -205,7 +205,7 @@ and sets \fIinterp\fR's result to an error message indicating that the \fBreturn\fR, \fBbreak\fR, or \fBcontinue\fR command was invoked in an inappropriate place. This means that top-level applications should never see a return code -from \fBTcl_EvalObjEx\fR other then \fBTCL_OK\fR or \fBTCL_ERROR\fR. +from \fBTcl_EvalObjEx\fR other than \fBTCL_OK\fR or \fBTCL_ERROR\fR. .SH KEYWORDS execute, file, global, result, script, value -- cgit v0.12 From 9b8fe92d1ec10b1010d91d504deab315538cce0e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 7 Feb 2017 12:11:29 +0000 Subject: =?UTF-8?q?Code=20cleanup=20(based=20on=20feedback=20from=20Ren?= =?UTF-8?q?=C3=A9=20Zaumseil):=20Only=20call=20GetInvalidIntFromObj()=20wh?= =?UTF-8?q?en=20Tcl=5FGetIntFromObj()=20fails.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- generic/tclLink.c | 203 +++++++++++++++++++++++------------------------------- 1 file changed, 85 insertions(+), 118 deletions(-) diff --git a/generic/tclLink.c b/generic/tclLink.c index f8f2342..7d1e3a8 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -67,10 +67,9 @@ typedef struct Link { static char * LinkTraceProc(ClientData clientData,Tcl_Interp *interp, const char *name1, const char *name2, int flags); static Tcl_Obj * ObjValue(Link *linkPtr); -static int GetInvalidIntFromObj(Tcl_Obj *objPtr, - int *intPtr); -static int GetInvalidDoubleFromObj(Tcl_Obj *objPtr, - double *doublePtr); +static int GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr); +static int GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr); +static int GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr); /* * Convenience macro for accessing the value of the C variable pointed to by a @@ -263,7 +262,8 @@ LinkTraceProc( int flags) /* Miscellaneous additional information. */ { Link *linkPtr = clientData; - int changed, valueLength; + int changed; + size_t valueLength; const char *value; char **pp; Tcl_Obj *valueObj; @@ -382,40 +382,31 @@ LinkTraceProc( switch (linkPtr->type) { case TCL_LINK_INT: - if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i) - != TCL_OK) { - if (GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) - != TCL_OK) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK + && GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) != TCL_OK) { + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable must have integer value"; - } + return (char *) "variable must have integer value"; } LinkedVar(int) = linkPtr->lastValue.i; break; case TCL_LINK_WIDE_INT: - if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w) - != TCL_OK) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w) != TCL_OK + && GetInvalidWideFromObj(valueObj, &linkPtr->lastValue.w) != TCL_OK) { + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable must have integer value"; - } - linkPtr->lastValue.w = (Tcl_WideInt) valueInt; + return (char *) "variable must have integer value"; } LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w; break; case TCL_LINK_DOUBLE: - if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) - != TCL_OK) { + if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) { #ifdef ACCEPT_NAN if (valueObj->typePtr != &tclDoubleType) { #endif - if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) - != TCL_OK) { + if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have real value"; @@ -429,8 +420,7 @@ LinkTraceProc( break; case TCL_LINK_BOOLEAN: - if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i) - != TCL_OK) { + if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have boolean value"; @@ -439,148 +429,113 @@ LinkTraceProc( break; case TCL_LINK_CHAR: - if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK + if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK + && GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) || valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), - TCL_GLOBAL_ONLY); - return (char *) "variable must have char value"; - } + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + TCL_GLOBAL_ONLY); + return (char *) "variable must have char value"; } - linkPtr->lastValue.c = (char)valueInt; - LinkedVar(char) = linkPtr->lastValue.c; + LinkedVar(char) = linkPtr->lastValue.c = (char)valueInt; break; case TCL_LINK_UCHAR: - if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK + if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK + && GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) || valueInt < 0 || valueInt > UCHAR_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), - TCL_GLOBAL_ONLY); - return (char *) "variable must have unsigned char value"; - } + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + TCL_GLOBAL_ONLY); + return (char *) "variable must have unsigned char value"; } - linkPtr->lastValue.uc = (unsigned char) valueInt; - LinkedVar(unsigned char) = linkPtr->lastValue.uc; + LinkedVar(unsigned char) = linkPtr->lastValue.uc = (unsigned char) valueInt; break; case TCL_LINK_SHORT: - if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK + if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK + && GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) || valueInt < SHRT_MIN || valueInt > SHRT_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), - TCL_GLOBAL_ONLY); - return (char *) "variable must have short value"; - } + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + TCL_GLOBAL_ONLY); + return (char *) "variable must have short value"; } - linkPtr->lastValue.s = (short)valueInt; - LinkedVar(short) = linkPtr->lastValue.s; + LinkedVar(short) = linkPtr->lastValue.s = (short)valueInt; break; case TCL_LINK_USHORT: - if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK + if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK + && GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) || valueInt < 0 || valueInt > USHRT_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), - TCL_GLOBAL_ONLY); - return (char *) "variable must have unsigned short value"; - } + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + TCL_GLOBAL_ONLY); + return (char *) "variable must have unsigned short value"; } - linkPtr->lastValue.us = (unsigned short)valueInt; - LinkedVar(unsigned short) = linkPtr->lastValue.us; + LinkedVar(unsigned short) = linkPtr->lastValue.us = (unsigned short)valueInt; break; case TCL_LINK_UINT: - if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK + if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK + && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) || valueWide < 0 || valueWide > UINT_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), - TCL_GLOBAL_ONLY); - return (char *) "variable must have unsigned int value"; - } - linkPtr->lastValue.ui = (unsigned int)valueInt; - } else { - linkPtr->lastValue.ui = (unsigned int)valueWide; + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + TCL_GLOBAL_ONLY); + return (char *) "variable must have unsigned int value"; } - LinkedVar(unsigned int) = linkPtr->lastValue.ui; + LinkedVar(unsigned int) = linkPtr->lastValue.ui = (unsigned int)valueWide; break; case TCL_LINK_LONG: - if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK + if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK + && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) || valueWide < LONG_MIN || valueWide > LONG_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), - TCL_GLOBAL_ONLY); - return (char *) "variable must have long value"; - } - linkPtr->lastValue.l = (long)valueInt; - } else { - linkPtr->lastValue.l = (long)valueWide; + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + TCL_GLOBAL_ONLY); + return (char *) "variable must have long value"; } - LinkedVar(long) = linkPtr->lastValue.l; + LinkedVar(long) = linkPtr->lastValue.l = (long)valueWide; break; case TCL_LINK_ULONG: - if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK + if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK + && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) || valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), - TCL_GLOBAL_ONLY); - return (char *) "variable must have unsigned long value"; - } - linkPtr->lastValue.ul = (unsigned long)valueInt; - } else { - linkPtr->lastValue.ul = (unsigned long)valueWide; + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + TCL_GLOBAL_ONLY); + return (char *) "variable must have unsigned long value"; } - LinkedVar(unsigned long) = linkPtr->lastValue.ul; + LinkedVar(unsigned long) = linkPtr->lastValue.ul = (unsigned long)valueWide; break; case TCL_LINK_WIDE_UINT: /* * FIXME: represent as a bignum. */ - if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK) { - if (GetInvalidIntFromObj(valueObj, &valueInt) - != TCL_OK) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), - TCL_GLOBAL_ONLY); - return (char *) "variable must have unsigned wide int value"; - } - linkPtr->lastValue.uw = (Tcl_WideUInt)valueInt; - } else { - linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide; + if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK + && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) { + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + TCL_GLOBAL_ONLY); + return (char *) "variable must have unsigned wide int value"; } - LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw; + LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide; break; case TCL_LINK_FLOAT: - if (Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK + if ((Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK + && GetInvalidDoubleFromObj(valueObj, &valueDouble) != TCL_OK) || valueDouble < -FLT_MAX || valueDouble > FLT_MAX) { - if (GetInvalidDoubleFromObj(valueObj, &valueDouble) - != TCL_OK) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), - TCL_GLOBAL_ONLY); - return (char *) "variable must have float value"; - } + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + TCL_GLOBAL_ONLY); + return (char *) "variable must have float value"; } - linkPtr->lastValue.f = (float)valueDouble; - LinkedVar(float) = linkPtr->lastValue.f; + LinkedVar(float) = linkPtr->lastValue.f = (float)valueDouble; break; case TCL_LINK_STRING: - value = TclGetStringFromObj(valueObj, &valueLength); - valueLength++; + value = TclGetString(valueObj); + valueLength = valueObj->length + 1; pp = (char **) linkPtr->addr; *pp = ckrealloc(*pp, valueLength); - memcpy(*pp, value, (unsigned) valueLength); + memcpy(*pp, value, valueLength); break; default: @@ -742,6 +697,18 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr, return TCL_ERROR; } +int +GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr) +{ + int intValue; + + if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) { + return TCL_ERROR; + } + *widePtr = intValue; + return TCL_OK; +} + /* * This function checks for double representations, which are valid * when linking with C variables, but which are invalid in other -- cgit v0.12 From 8eedc41ff2550dbd1882d89dd2770074fcfd4bcd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 8 Feb 2017 11:42:12 +0000 Subject: FlightAware feedback: "Aside: Any way to find out what the pkgIndex.tcl file a package was defined in was, or does that happen at too high a level?" Answer: Even though the name of the pkgIndex file is available earlier, it is very well possible to remember it and store it with the other files. This commit does exactly that. --- generic/tclPkg.c | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 0759faa..9ad3cb7 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -32,6 +32,7 @@ typedef struct PkgAvail { char *script; /* Script to invoke to provide this version of * the package. Malloc'ed and protected by * Tcl_Preserve and Tcl_Release. */ + char *pkgIndex; /* Full file name of pkgIndex file */ struct PkgAvail *nextPtr; /* Next in list of available versions of the * same package. */ } PkgAvail; @@ -573,6 +574,9 @@ PkgRequireCore( pkgName->nextPtr = pkgFiles->names; strcpy(pkgName->name, name); pkgFiles->names = pkgName; + if (bestPtr->pkgIndex) { + TclPkgFileSeen(interp, bestPtr->pkgIndex); + } code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL); /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/ pkgFiles->names = pkgName->nextPtr; @@ -921,6 +925,9 @@ Tcl_PackageObjCmd( pkgPtr->availPtr = availPtr->nextPtr; Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC); Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); + if (availPtr->pkgIndex) { + Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); + } ckfree(availPtr); } ckfree(pkgPtr); @@ -971,6 +978,9 @@ Tcl_PackageObjCmd( return TCL_OK; } Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); + if (availPtr->pkgIndex) { + Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); + } break; } } @@ -981,6 +991,7 @@ Tcl_PackageObjCmd( } if (availPtr == NULL) { availPtr = ckalloc(sizeof(PkgAvail)); + availPtr->pkgIndex = 0; DupBlock(availPtr->version, argv3, (unsigned) length + 1); if (prevPtr == NULL) { @@ -991,6 +1002,10 @@ Tcl_PackageObjCmd( prevPtr->nextPtr = availPtr; } } + if (iPtr->scriptFile) { + argv4 = TclGetStringFromObj(iPtr->scriptFile, &length); + DupBlock(availPtr->pkgIndex, argv4, (unsigned) length + 1); + } argv4 = TclGetStringFromObj(objv[4], &length); DupBlock(availPtr->script, argv4, (unsigned) length + 1); break; @@ -1346,6 +1361,9 @@ TclFreePackageInfo( pkgPtr->availPtr = availPtr->nextPtr; Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC); Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); + if (availPtr->pkgIndex) { + Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); + } ckfree(availPtr); } ckfree(pkgPtr); -- cgit v0.12 From f0d4f625858cad553260fa36346ff6f023a77473 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 8 Feb 2017 14:32:13 +0000 Subject: Shortcut in TclParseNumber(): If obj is a dict or list, don't bother to generate the string representation if we know already beforehand that the parsing will fail. Use TCL_NO_DEPRECATED in stead of KILL_OCTAL for removing the (deprecated un-prefixed) octal support. Adapt test-cases, so they work without octal support as well. --- generic/tclHistory.c | 5 ++--- generic/tclStrToD.c | 27 +++++++++++++++++---------- tests/get.test | 8 ++++---- tests/parseExpr.test | 5 ++--- 4 files changed, 25 insertions(+), 20 deletions(-) diff --git a/generic/tclHistory.c b/generic/tclHistory.c index b08e352..47806d4 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -62,15 +62,14 @@ Tcl_RecordAndEval( * instead of Tcl_Eval. */ { register Tcl_Obj *cmdPtr; - int length = strlen(cmd); int result; - if (length > 0) { + if (cmd[0]) { /* * Call Tcl_RecordAndEvalObj to do the actual work. */ - cmdPtr = Tcl_NewStringObj(cmd, length); + cmdPtr = Tcl_NewStringObj(cmd, -1); Tcl_IncrRefCount(cmdPtr); result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 6da6df3..77e1839 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -18,13 +18,6 @@ #include /* - * Define KILL_OCTAL to suppress interpretation of numbers with leading zero - * as octal. (Ceterum censeo: numeros octonarios delendos esse.) - */ - -#undef KILL_OCTAL - -/* * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754 * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be * uniquely determined by radix and by the widths of significand and exponent. @@ -546,6 +539,20 @@ TclParseNumber( */ if (bytes == NULL) { + if (endPtrPtr == NULL) { + if (objPtr->typePtr == &tclDictType) { + /* A dict can never be a (single) number */ + return TCL_ERROR; + } + if (objPtr->typePtr == &tclListType) { + int length; + /* A list can only be a (single) number if its length == 1 */ + TclListObjLength(NULL, objPtr, &length); + if (length != 1) { + return TCL_ERROR; + } + } + } bytes = TclGetString(objPtr); } @@ -657,7 +664,7 @@ TclParseNumber( state = ZERO_O; break; } -#ifdef KILL_OCTAL +#ifdef TCL_NO_DEPRECATED goto decimal; #endif /* FALLTHROUGH */ @@ -740,7 +747,7 @@ TclParseNumber( goto endgame; } -#ifndef KILL_OCTAL +#ifndef TCL_NO_DEPRECATED /* * Scanned a number with a leading zero that contains an 8, 9, @@ -879,7 +886,7 @@ TclParseNumber( * digits. */ -#ifdef KILL_OCTAL +#ifdef TCL_NO_DEPRECATED decimal: #endif acceptState = state; diff --git a/tests/get.test b/tests/get.test index 7aa06c1..d6a7206 100644 --- a/tests/get.test +++ b/tests/get.test @@ -98,17 +98,17 @@ test get-3.2 {Tcl_GetDouble(FromObj), bad numbers} { } {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}} # Bug 7114ac6141 test get-3.3 {tcl_GetInt with iffy numbers} testgetint { - lmap x {0 " 0" "0 " " 0 " " 0xa " " 010 " " 0o10 " " 0b10 "} { + lmap x {0 " 0" "0 " " 0 " " 0xa " " 007 " " 0o10 " " 0b10 "} { catch {testgetint 44 $x} x set x } -} {44 44 44 44 54 52 52 46} +} {44 44 44 44 54 51 52 46} test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj { - lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} { + lmap x {0 0.0 " .0" ".0 " " 0e0 " "07" "- 0" "-0" "0o12" "0b10"} { catch {testdoubleobj set 1 $x} x set x } -} {0.0 0.0 0.0 0.0 0.0 {expected floating-point number but got "09" (looks like invalid octal number)} {expected floating-point number but got "- 0"} 0.0 10.0 2.0} +} {0.0 0.0 0.0 0.0 0.0 7.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0} # cleanup ::tcltest::cleanupTests diff --git a/tests/parseExpr.test b/tests/parseExpr.test index fda25b7..47dbec5 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -1044,9 +1044,8 @@ test parseExpr-22.13 {Bug 3401704} -constraints testexprparser -body { } -result {- {} 0 subexpr naner() 1 operator naner 0 {}} test parseExpr-22.14 {Bug 3401704} -constraints testexprparser -body { - catch {testexprparser 08 -1} m o - dict get $o -errorcode -} -result {TCL PARSE EXPR BADNUMBER OCTAL} + testexprparser 07 -1 +} -result {- {} 0 subexpr 07 1 text 07 0 {}} test parseExpr-22.15 {Bug 3401704} -constraints testexprparser -body { catch {testexprparser 0o8 -1} m o dict get $o -errorcode -- cgit v0.12 From f76fe71e68ec63ca5fd7068025e772ffdf758789 Mon Sep 17 00:00:00 2001 From: aspect Date: Sat, 11 Feb 2017 05:06:43 +0000 Subject: zlib stream finalize calls deflate with no input - this case (and this case only) must be allowed. Fixes 2nd issue in [25842c161f], introduced by [c1aff52ef3] --- generic/tclZlib.c | 4 ++-- tests/zlib.test | 12 ++++++++++++ 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/generic/tclZlib.c b/generic/tclZlib.c index e5a5946..82486d2 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -1204,10 +1204,10 @@ Tcl_ZlibStreamPut( zshPtr->stream.avail_in = size; /* - * Must not do a zero-length compress. [Bug 25842c161] + * Must not do a zero-length compress unless finalizing. [Bug 25842c161] */ - if (size == 0) { + if (size == 0 && flush != Z_FINISH) { return TCL_OK; } diff --git a/tests/zlib.test b/tests/zlib.test index ae8742b..3ee7a45 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -157,6 +157,18 @@ test zlib-7.8 {zlib stream: Bug b26e38a3e4} -constraints zlib -setup { catch {$strm close} unset -nocomplain randdata data } -result {120185 18003000} +test zlib-7.9 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup { + set z1 [zlib stream gzip] + set z2 [zlib stream gzip] +} -body { + $z1 put ABCDEedbca.. + $z1 finalize + $z2 put -finalize ABCDEedbca.. + expr {[$z1 get] eq [$z2 get]} +} -cleanup { + $z1 close + $z2 close +} -result 1 test zlib-8.1 {zlib transformation} -constraints zlib -setup { set file [makeFile {} test.gz] -- cgit v0.12 From 946a00999108508220f54a76817b73262a6aa827 Mon Sep 17 00:00:00 2001 From: aspect Date: Sat, 11 Feb 2017 07:18:08 +0000 Subject: better tests for finalization --- tests/zlib.test | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/tests/zlib.test b/tests/zlib.test index 3ee7a45..9497979 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -169,6 +169,30 @@ test zlib-7.9 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup { $z1 close $z2 close } -result 1 +test zlib-7.9.1 {zlib stream put -finalize (bug 25842c161)} -constraints zlib -setup { + set c [zlib stream gzip] + set d [zlib stream gunzip] +} -body { + $c put abcdeEDCBA.. + $c finalize + $d put [$c get] + $d finalize + $d get +} -cleanup { + $c close + $d close +} -result abcdeEDCBA.. +test zlib-7.9.2 {zlib stream put; zlib stream finalize (bug 25842c161)} -constraints zlib -setup { + set c [zlib stream gzip] + set d [zlib stream gunzip] +} -body { + $c put -finalize abcdeEDCBA.. + $d put -finalize [$c get] + $d get +} -cleanup { + $c close + $d close +} -result abcdeEDCBA.. test zlib-8.1 {zlib transformation} -constraints zlib -setup { set file [makeFile {} test.gz] -- cgit v0.12 From 3d6a406232dc52b9f475ef7ef3cfa77f8fa01b35 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 14 Feb 2017 14:25:08 +0000 Subject: On Windows, Cygwin and 64-bit platforms, no need to handle 'long' in tclLink.c, since its size is equal to either 'int' or 'Tcl_WideInt'. This enhances interoperabilty between win64 extensions loaded in cygwin64 using Tcl_LinkVar(), whill still being 100% compatible. init.tcl: unnecessary spacing. --- generic/tcl.h | 5 +++++ generic/tclLink.c | 16 ++++++++++++++++ library/init.tcl | 4 ++-- 3 files changed, 23 insertions(+), 2 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index c0cee27..d678229 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1147,8 +1147,13 @@ typedef struct Tcl_DString { #define TCL_LINK_SHORT 8 #define TCL_LINK_USHORT 9 #define TCL_LINK_UINT 10 +#if defined(TCL_WIDE_INT_IS_LONG) || defined(_WIN32) || defined(__CYGWIN__) +#define TCL_LINK_LONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_INT : TCL_LINK_INT) +#define TCL_LINK_ULONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT) +#else #define TCL_LINK_LONG 11 #define TCL_LINK_ULONG 12 +#endif #define TCL_LINK_FLOAT 13 #define TCL_LINK_WIDE_UINT 14 #define TCL_LINK_READ_ONLY 0x80 diff --git a/generic/tclLink.c b/generic/tclLink.c index 1507804..a39dfcd 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -36,8 +36,10 @@ typedef struct Link { unsigned int ui; short s; unsigned short us; +#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__) long l; unsigned long ul; +#endif Tcl_WideInt w; Tcl_WideUInt uw; float f; @@ -129,6 +131,14 @@ Tcl_LinkVar( Tcl_IncrRefCount(linkPtr->varName); linkPtr->addr = addr; linkPtr->type = type & ~TCL_LINK_READ_ONLY; +#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \ + || defined(_WIN32) || defined(__CYGWIN__)) + if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) { + linkPtr->type = TCL_LINK_LONG; + } else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) { + linkPtr->type = TCL_LINK_ULONG; + } +#endif if (type & TCL_LINK_READ_ONLY) { linkPtr->flags = LINK_READ_ONLY; } else { @@ -335,12 +345,14 @@ LinkTraceProc( case TCL_LINK_UINT: changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui); break; +#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__) case TCL_LINK_LONG: changed = (LinkedVar(long) != linkPtr->lastValue.l); break; case TCL_LINK_ULONG: changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul); break; +#endif case TCL_LINK_FLOAT: changed = (LinkedVar(float) != linkPtr->lastValue.f); break; @@ -483,6 +495,7 @@ LinkTraceProc( LinkedVar(unsigned int) = linkPtr->lastValue.ui = (unsigned int)valueWide; break; +#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__) case TCL_LINK_LONG: if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) @@ -504,6 +517,7 @@ LinkTraceProc( } LinkedVar(unsigned long) = linkPtr->lastValue.ul = (unsigned long)valueWide; break; +#endif case TCL_LINK_WIDE_UINT: /* @@ -597,12 +611,14 @@ ObjValue( case TCL_LINK_UINT: linkPtr->lastValue.ui = LinkedVar(unsigned int); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui); +#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__) case TCL_LINK_LONG: linkPtr->lastValue.l = LinkedVar(long); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l); case TCL_LINK_ULONG: linkPtr->lastValue.ul = LinkedVar(unsigned long); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul); +#endif case TCL_LINK_FLOAT: linkPtr->lastValue.f = LinkedVar(float); return Tcl_NewDoubleObj(linkPtr->lastValue.f); diff --git a/library/init.tcl b/library/init.tcl index 49a523c..fac1722 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -470,9 +470,9 @@ proc auto_load {cmd {namespace {}}} { proc ::tcl::Pkg::source {filename} { if {[interp issafe]} { - uplevel 1 [list ::source $filename] + uplevel 1 [list ::source $filename] } else { - uplevel 1 [list ::source -nopkg $filename] + uplevel 1 [list ::source -nopkg $filename] } } -- cgit v0.12 From 3b5e7e9792b9b34111146557a3353756711b8133 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 15 Feb 2017 14:04:15 +0000 Subject: More internal use of size_t in stead of int, e.g. for epoch's --- generic/tclBasic.c | 2 +- generic/tclCompile.h | 2 +- generic/tclEnsemble.c | 2 +- generic/tclIO.c | 2 +- generic/tclIO.h | 2 +- generic/tclInt.h | 12 ++++++------ generic/tclObj.c | 6 +++--- 7 files changed, 14 insertions(+), 14 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 63c5590..6ff5faa 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4705,7 +4705,7 @@ TEOV_RunEnterTraces( { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; - int newEpoch, cmdEpoch = cmdPtr->cmdEpoch; + size_t newEpoch, cmdEpoch = cmdPtr->cmdEpoch; int length, traceCode = TCL_OK; const char *command = TclGetStringFromObj(commandPtr, &length); diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 5ef154e..5bc3e81 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -425,7 +425,7 @@ typedef struct ByteCode { * compiled. If the code is executed if a * different namespace, it must be * recompiled. */ - int nsEpoch; /* Value of nsPtr->resolverEpoch when this + size_t nsEpoch; /* Value of nsPtr->resolverEpoch when this * ByteCode was compiled. Used to invalidate * code when new namespace resolution rules * are put into effect. */ diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 6ada155..f3e8187 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -92,7 +92,7 @@ static const Tcl_ObjType ensembleCmdType = { */ typedef struct { - int epoch; /* Used to confirm when the data in this + size_t epoch; /* Used to confirm when the data in this * really structure matches up with the * ensemble. */ Command *token; /* Reference to the command for which this diff --git a/generic/tclIO.c b/generic/tclIO.c index 506e6d5..6bf8451 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -321,7 +321,7 @@ static int WillRead(Channel *chanPtr); typedef struct ResolvedChanName { ChannelState *statePtr; /* The saved lookup result */ Tcl_Interp *interp; /* The interp in which the lookup was done. */ - int epoch; /* The epoch of the channel when the lookup + size_t epoch; /* The epoch of the channel when the lookup * was done. Use to verify validity. */ size_t refCount; /* Share this struct among many Tcl_Obj. */ } ResolvedChanName; diff --git a/generic/tclIO.h b/generic/tclIO.h index ffbfa31..07c54fa 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -214,7 +214,7 @@ typedef struct ChannelState { * because it happened in the background. The * value is the chanMg, if any. #219's * companion to 'unreportedError'. */ - int epoch; /* Used to test validity of stored channelname + size_t epoch; /* Used to test validity of stored channelname * lookup results. */ } ChannelState; diff --git a/generic/tclInt.h b/generic/tclInt.h index 4b87962..f078d18 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -265,7 +265,7 @@ typedef struct Namespace { * strings; values have type (Namespace *). If * NULL, there are no children. */ #endif - long nsId; /* Unique id for the namespace. */ + size_t nsId; /* Unique id for the namespace. */ Tcl_Interp *interp; /* The interpreter containing this * namespace. */ int flags; /* OR-ed combination of the namespace status @@ -299,12 +299,12 @@ typedef struct Namespace { * registered using "namespace export". */ int maxExportPatterns; /* Mumber of export patterns for which space * is currently allocated. */ - int cmdRefEpoch; /* Incremented if a newly added command + size_t cmdRefEpoch; /* Incremented if a newly added command * shadows a command for which this namespace * has already cached a Command* pointer; this * causes all its cached Command* pointers to * be invalidated. */ - int resolverEpoch; /* Incremented whenever (a) the name + size_t resolverEpoch; /* Incremented whenever (a) the name * resolution rules change for this namespace * or (b) a newly added command shadows a * command that is compiled to bytecodes. This @@ -331,7 +331,7 @@ typedef struct Namespace { * LookupCompiledLocal to resolve variable * references within the namespace at compile * time. */ - int exportLookupEpoch; /* Incremented whenever a command is added to + size_t exportLookupEpoch; /* Incremented whenever a command is added to * a namespace, removed from a namespace or * the exports of a namespace are changed. * Allows TIP#112-driven command lists to be @@ -432,7 +432,7 @@ typedef struct EnsembleConfig { * if the command has been deleted (or never * existed; the global namespace never has an * ensemble command.) */ - int epoch; /* The epoch at which this ensemble's table of + size_t epoch; /* The epoch at which this ensemble's table of * exported commands is valid. */ char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all * consistent points, this will have the same @@ -1639,7 +1639,7 @@ typedef struct Command { * representing a command's name in a ByteCode * instruction sequence. This structure can be * freed when refCount becomes zero. */ - int cmdEpoch; /* Incremented to invalidate any references + size_t cmdEpoch; /* Incremented to invalidate any references * that point to this command when it is * renamed, deleted, hidden, or exposed. */ CompileProc *compileProc; /* Procedure called to compile command. NULL diff --git a/generic/tclObj.c b/generic/tclObj.c index 1abbb31..7ec259f 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -344,17 +344,17 @@ typedef struct ResolvedCmdName { * reference (not the namespace that contains * the referenced command). NULL if the name * is fully qualified.*/ - long refNsId; /* refNsPtr's unique namespace id. Used to + size_t refNsId; /* refNsPtr's unique namespace id. Used to * verify that refNsPtr is still valid (e.g., * it's possible that the cmd's containing * namespace was deleted and a new one created * at the same address). */ - int refNsCmdEpoch; /* Value of the referencing namespace's + size_t refNsCmdEpoch; /* Value of the referencing namespace's * cmdRefEpoch when the pointer was cached. * Before using the cached pointer, we check * if the namespace's epoch was incremented; * if so, this cached pointer is invalid. */ - int cmdEpoch; /* Value of the command's cmdEpoch when this + size_t cmdEpoch; /* Value of the command's cmdEpoch when this * pointer was cached. Before using the cached * pointer, we check if the cmd's epoch was * incremented; if so, the cmd was renamed, -- cgit v0.12 From 6a29cbc151dd60bc01bd1f272be2b9c48371b453 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 26 Feb 2017 13:19:08 +0000 Subject: Make tests produce more meaningful information when they fail. --- tests/zlib.test | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/tests/zlib.test b/tests/zlib.test index 9497979..ba861e0 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -163,13 +163,19 @@ test zlib-7.9 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup { } -body { $z1 put ABCDEedbca.. $z1 finalize - $z2 put -finalize ABCDEedbca.. - expr {[$z1 get] eq [$z2 get]} + zlib gunzip [$z1 get] } -cleanup { $z1 close +} -result ABCDEedbca.. +test zlib-7.9.1 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup { + set z2 [zlib stream gzip] +} -body { + $z2 put -finalize ABCDEedbca.. + zlib gunzip [$z2 get] +} -cleanup { $z2 close -} -result 1 -test zlib-7.9.1 {zlib stream put -finalize (bug 25842c161)} -constraints zlib -setup { +} -result ABCDEedbca.. +test zlib-7.9.2 {zlib stream put -finalize (bug 25842c161)} -constraints zlib -setup { set c [zlib stream gzip] set d [zlib stream gunzip] } -body { @@ -182,7 +188,7 @@ test zlib-7.9.1 {zlib stream put -finalize (bug 25842c161)} -constraints zlib -s $c close $d close } -result abcdeEDCBA.. -test zlib-7.9.2 {zlib stream put; zlib stream finalize (bug 25842c161)} -constraints zlib -setup { +test zlib-7.9.3 {zlib stream put; zlib stream finalize (bug 25842c161)} -constraints zlib -setup { set c [zlib stream gzip] set d [zlib stream gunzip] } -body { -- cgit v0.12 From a9c42fa686ab9236f5218c276ce4bfdc7655ab16 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 26 Feb 2017 15:28:29 +0000 Subject: Might as well number tests more conventionally. --- tests/zlib.test | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/zlib.test b/tests/zlib.test index ba861e0..1e69745 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -167,7 +167,7 @@ test zlib-7.9 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup { } -cleanup { $z1 close } -result ABCDEedbca.. -test zlib-7.9.1 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup { +test zlib-7.10 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup { set z2 [zlib stream gzip] } -body { $z2 put -finalize ABCDEedbca.. @@ -175,7 +175,7 @@ test zlib-7.9.1 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup } -cleanup { $z2 close } -result ABCDEedbca.. -test zlib-7.9.2 {zlib stream put -finalize (bug 25842c161)} -constraints zlib -setup { +test zlib-7.11 {zlib stream put -finalize (bug 25842c161)} -constraints zlib -setup { set c [zlib stream gzip] set d [zlib stream gunzip] } -body { @@ -188,7 +188,7 @@ test zlib-7.9.2 {zlib stream put -finalize (bug 25842c161)} -constraints zlib -s $c close $d close } -result abcdeEDCBA.. -test zlib-7.9.3 {zlib stream put; zlib stream finalize (bug 25842c161)} -constraints zlib -setup { +test zlib-7.12 {zlib stream put; zlib stream finalize (bug 25842c161)} -constraints zlib -setup { set c [zlib stream gzip] set d [zlib stream gunzip] } -body { -- cgit v0.12 From 11e95f1ff7b8996c35878bb283ee33e5c263c08c Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 27 Feb 2017 14:51:15 +0000 Subject: ParseTokens failed to fully respect its numBytes argument. --- generic/tclParse.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/generic/tclParse.c b/generic/tclParse.c index b40b636..6f989d9 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -1190,6 +1190,8 @@ ParseTokens( nestedPtr = (Tcl_Parse *) TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse)); while (1) { + const char *curEnd; + if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1, nestedPtr) != TCL_OK) { parsePtr->errorType = nestedPtr->errorType; @@ -1198,8 +1200,9 @@ ParseTokens( TclStackFree(parsePtr->interp, nestedPtr); return TCL_ERROR; } + curEnd = src + numBytes; src = nestedPtr->commandStart + nestedPtr->commandSize; - numBytes = parsePtr->end - src; + numBytes = curEnd - src; Tcl_FreeParse(nestedPtr); /* -- cgit v0.12 From 08192ab42f794f6a486fdc21a537cce794f04472 Mon Sep 17 00:00:00 2001 From: avl Date: Sun, 5 Mar 2017 15:05:48 +0000 Subject: Fix for Ticket [71c0878b71] + test cases --- generic/tclStrToD.c | 2 +- tests/incr.test | 12 ++++++++++++ 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 77e1839..224ab45 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -539,7 +539,7 @@ TclParseNumber( */ if (bytes == NULL) { - if (endPtrPtr == NULL) { + if (interp == NULL && endPtrPtr == NULL) { if (objPtr->typePtr == &tclDictType) { /* A dict can never be a (single) number */ return TCL_ERROR; diff --git a/tests/incr.test b/tests/incr.test index 9243be0..aa2872a 100644 --- a/tests/incr.test +++ b/tests/incr.test @@ -494,6 +494,18 @@ test incr-2.31 {incr command (compiled): bad increment} { (reading increment) invoked from within "incr x 1a"}} +test incr-2.32 {incr command (compiled): bad pure list increment} { + list [catch {incr x [list 1 2]} msg] $msg $::errorInfo +} {1 {expected integer but got "1 2"} {expected integer but got "1 2" + (reading increment) + invoked from within +"incr x [list 1 2]"}} +test incr-2.33 {incr command (compiled): bad pure dict increment} { + list [catch {incr x [dict create 1 2]} msg] $msg $::errorInfo +} {1 {expected integer but got "1 2"} {expected integer but got "1 2" + (reading increment) + invoked from within +"incr x [dict create 1 2]"}} test incr-3.1 {increment by wide amount: bytecode route} { set x 0 -- cgit v0.12 From 0c863a2fc66cae2abec782232dd633e0aa561672 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 6 Mar 2017 20:02:55 +0000 Subject: zlib.test: fix sporadic errors: - zlib-9.2 hangs because of too short update, if processed another event; - zlib-8.8 wrong non-blocking pipe usage - [string length $compressed] may return sporadically values smaller as expected (< 222) --- tests/zlib.test | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/tests/zlib.test b/tests/zlib.test index 1e69745..63bac7e 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -311,7 +311,7 @@ test zlib-8.8 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide } -constraints zlib -body { zlib push compress $outSide -dictionary $spdyDict - fconfigure $outSide -blocking 0 -translation binary -buffering none + fconfigure $outSide -blocking 1 -translation binary -buffering none fconfigure $inSide -blocking 1 -translation binary puts -nonewline $outSide $spdyHeaders chan pop $outSide @@ -508,6 +508,7 @@ test zlib-9.2 "socket fcopy with push" -constraints zlib -setup { chan configure $c -translation binary -buffering none -blocking 0 puts -nonewline $c [zlib gzip [string repeat a 81920]] close $c + set ::total -1 }}} 0] set file [makeFile {} test.gz] } -body { @@ -515,7 +516,10 @@ test zlib-9.2 "socket fcopy with push" -constraints zlib -setup { set sin [socket $addr $port] chan configure $sin -translation binary zlib push gunzip $sin - update + after 1000 {set ::total timeout} + vwait ::total + after cancel {set ::total timeout} + if {$::total != -1} {error "unexpected value $::total of ::total"} set total [fcopy $sin [set fout [open $file wb]]] close $sin close $fout -- cgit v0.12 From 542acc2feab327a28153eb288b65e3508a924be6 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 6 Mar 2017 20:05:13 +0000 Subject: nre.test: add constraint for nre-0.1 (testnreunwind may be not available) --- tests/nre.test | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/nre.test b/tests/nre.test index 9df5eb1..09061d2 100644 --- a/tests/nre.test +++ b/tests/nre.test @@ -64,9 +64,11 @@ if {[testConstraint testnrelevels]} { namespace import testnre::* } -test nre-0.1 {levels while unwinding} { +test nre-0.1 {levels while unwinding} -body { testnreunwind -} {0 0 0} +} -constraints { + testnrelevels +} -result {0 0 0} test nre-1.1 {self-recursive procs} -setup { proc a i [makebody {a $i}] -- cgit v0.12 From 72972a21efecd282225c91662d7f83037434f63e Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 6 Mar 2017 20:07:08 +0000 Subject: chanio.test: [win] fix test case (setup set translation to "lf", because of default translation on windows "crlf") --- tests/chanio.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/chanio.test b/tests/chanio.test index 9a27233..31bef36 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -6775,7 +6775,7 @@ test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} { } 5 test chan-io-52.11 {TclCopyChannel & encodings} -setup { set f [open $path(utf8-fcopy.txt) w] - fconfigure $f -encoding utf-8 + fconfigure $f -encoding utf-8 -translation lf puts $f "\u0410\u0410" close $f } -constraints {fcopy} -body { -- cgit v0.12