From 998409ea9b162e1f9a271add26637eb24792a2aa Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 12 Aug 2020 06:36:31 +0000 Subject: Update .travis.yml: remove deprecated "sudo" and rename "matrix" to "jobs" Fix travis build for Windows/Debug --- .travis.yml | 3 +-- win/tclWinPort.h | 4 +++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index b309e51..05c2f6a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,3 @@ -sudo: false language: c addons: apt: @@ -10,7 +9,7 @@ addons: - gcc-mingw-w64-i686 - gcc-mingw-w64-x86-64 - gcc-multilib -matrix: +jobs: include: # Testing on Linux with various compilers - name: "Linux/GCC/Shared" diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 3cab385..056c7c8 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -33,7 +33,9 @@ typedef DWORD_PTR * PDWORD_PTR; /* * Ask for the winsock function typedefs, also. */ -#define INCL_WINSOCK_API_TYPEDEFS 1 +#ifndef INCL_WINSOCK_API_TYPEDEFS +# define INCL_WINSOCK_API_TYPEDEFS 1 +#endif #include #ifdef CHECK_UNICODE_CALLS -- cgit v0.12 From 330e4967abb577c06a94a635e415c031030372f8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 12 Aug 2020 07:10:57 +0000 Subject: Fix value of CMD_DEAD flag --- generic/tclInt.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 1e90b70..317ae1f 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1682,7 +1682,7 @@ typedef struct Command { #define CMD_COMPILES_EXPANDED 0x08 #define CMD_REDEF_IN_PROGRESS 0x10 #define CMD_VIA_RESOLVER 0x20 -#define CMD_DEAD 0x30 +#define CMD_DEAD 0x40 /* -- cgit v0.12 From 52549ae747613994a8ced4de9b567bc4cc09443f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 12 Aug 2020 10:25:49 +0000 Subject: Fix [e87000d8425ab86a]: crash for "fconfigure stdout" in Win32. Even though the crash cannot happen in Tcl 8.6, the function Tcl_BadChannelOption() was to blame, so better fix that in 8.6 too. --- generic/tclIO.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 7abeb68..82eb581 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7699,7 +7699,7 @@ Tcl_BadChannelOption( } Tcl_ResetResult(interp); errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ", - optionName); + optionName ? optionName : ""); argc--; for (i = 0; i < argc; i++) { Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]); -- cgit v0.12 From 840355939de3409373a08bc3c0c216916d74521f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 13 Aug 2020 07:21:34 +0000 Subject: Testcase event-1.1 (still) fails occasionally on macOS --- tests/event.test | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/tests/event.test b/tests/event.test index b42909c..70d4cff 100644 --- a/tests/event.test +++ b/tests/event.test @@ -23,11 +23,12 @@ testConstraint testfilehandler [llength [info commands testfilehandler]] testConstraint testexithandler [llength [info commands testexithandler]] testConstraint testfilewait [llength [info commands testfilewait]] testConstraint exec [llength [info commands exec]] - +testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}] + test event-1.1 {Tcl_CreateFileHandler, reading} -setup { testfilehandler close set result "" -} -constraints testfilehandler -body { +} -constraints {testfilehandler notOSX} -body { testfilehandler create 0 readable off testfilehandler clear 0 testfilehandler oneevent -- cgit v0.12 From e1968256d828d5f86f7ee09eaea945332df127b1 Mon Sep 17 00:00:00 2001 From: culler Date: Mon, 17 Aug 2020 15:53:04 +0000 Subject: Try to make io-50.6 more robust on the Travis macOS VM --- tests/io.test | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/tests/io.test b/tests/io.test index 685394c..016c6bd 100644 --- a/tests/io.test +++ b/tests/io.test @@ -6871,7 +6871,7 @@ test io-50.5 {testing handler deletion vs reentrant calls} -constraints {testcha } -cleanup { close $f } -result [list {del calling recursive} {del deleted notcalled} \ - {del deleted myself} {del after recursive}] + {del deleted myself} {del after recursive}] test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup { file delete $path(test1) } -body { @@ -6880,6 +6880,7 @@ test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testcha proc first {f} { variable u variable z + variable done if {"$u" == "toplevel"} { lappend z "first called" set u first @@ -6887,6 +6888,7 @@ test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testcha vwait z after cancel $timer lappend z "first after toplevel" + set done 1 } else { lappend z "first called not toplevel" } @@ -6908,19 +6910,24 @@ test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testcha } set z "" set u toplevel + set done 0 testservicemode 0 set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list second $f]] testchannelevent $f add readable [namespace code [list first $f]] testservicemode 1 update + if {!$done} { + set $timer2 [after 200 lappend done timeout] + vwait done + after cancel timer2 + } set z } -cleanup { close $f } -result [list {first called} {first called not toplevel} \ {second called, first time} {second called, second time} \ {first after toplevel}] - test io-51.1 {Test old socket deletion on Macintosh} {socket} { set x 0 set result "" -- cgit v0.12 From 270c9b99d653dad45f98e06a5c503a6338479ac9 Mon Sep 17 00:00:00 2001 From: culler Date: Mon, 17 Aug 2020 16:21:05 +0000 Subject: Add the missing $. --- tests/io.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/io.test b/tests/io.test index 016c6bd..6e2c907 100644 --- a/tests/io.test +++ b/tests/io.test @@ -6920,7 +6920,7 @@ test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testcha if {!$done} { set $timer2 [after 200 lappend done timeout] vwait done - after cancel timer2 + after cancel $timer2 } set z } -cleanup { -- cgit v0.12 From 6560454489df369db2c1edeaaf82a094efda0115 Mon Sep 17 00:00:00 2001 From: culler Date: Mon, 17 Aug 2020 16:28:28 +0000 Subject: And remove the other $ and do the test slightly differently. Inability to test locally is a challenge. --- tests/io.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/io.test b/tests/io.test index 6e2c907..18636c1 100644 --- a/tests/io.test +++ b/tests/io.test @@ -6918,7 +6918,7 @@ test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testcha testservicemode 1 update if {!$done} { - set $timer2 [after 200 lappend done timeout] + set timer2 [after 200 set done 1] vwait done after cancel $timer2 } -- cgit v0.12 From 591c90cd3e7e44d16dc721a6b3d7a66c6746c2eb Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 21 Aug 2020 13:59:13 +0000 Subject: Suppress tests that fail starting with OSX Mojave. --- tests/socket.test | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/socket.test b/tests/socket.test index 3544dd9..469367a 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -199,6 +199,8 @@ if {[testConstraint doTestsWithRemoteServer]} { } } +testConstraint notOSX [string compare $::tcl_platform(os) Darwin] + test socket-1.1 {arg parsing for socket command} {socket} { list [catch {socket -server} msg] $msg } {1 {no argument given for -server option}} @@ -816,7 +818,7 @@ test socket-4.2 {byte order problems, socket numbers, htons} {socket} { } ok test socket-5.1 {byte order problems, socket numbers, htons} \ - {socket unix notRoot} { + {socket unix notRoot notOSX} { set x {couldn't open socket: not owner} if {![catch {socket -server dodo 0x1} msg]} { set x {htons problem, should be disallowed, are you running as SU?} @@ -833,7 +835,7 @@ test socket-5.2 {byte order problems, socket numbers, htons} {socket} { set x } {couldn't open socket: port number too high} test socket-5.3 {byte order problems, socket numbers, htons} \ - {socket unix notRoot} { + {socket unix notRoot notOSX} { set x {couldn't open socket: not owner} if {![catch {socket -server dodo 21} msg]} { set x {htons problem, should be disallowed, are you running as SU?} -- cgit v0.12 From b2d5b24a704988578dfaa93e7cead7428be9ccbc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 24 Aug 2020 07:57:04 +0000 Subject: Upgrade Travis build from bionic to focal --- .travis.yml | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/.travis.yml b/.travis.yml index 05c2f6a..dd86769 100644 --- a/.travis.yml +++ b/.travis.yml @@ -14,48 +14,48 @@ jobs: # Testing on Linux with various compilers - name: "Linux/GCC/Shared" os: linux - dist: bionic + dist: focal compiler: gcc env: - BUILD_DIR=unix - name: "Linux/GCC/Shared: UTF_MAX=4" os: linux - dist: bionic + dist: focal compiler: gcc env: - BUILD_DIR=unix - CFGOPT=CFLAGS=-DTCL_UTF_MAX=4 - name: "Linux/GCC/Shared: UTF_MAX=5" os: linux - dist: bionic + dist: focal compiler: gcc env: - BUILD_DIR=unix - CFGOPT=CFLAGS=-DTCL_UTF_MAX=5 - name: "Linux/GCC/Shared: UTF_MAX=6" os: linux - dist: bionic + dist: focal compiler: gcc env: - BUILD_DIR=unix - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6 - name: "Linux/GCC/Static" os: linux - dist: bionic + dist: focal compiler: gcc env: - CFGOPT="--disable-shared" - BUILD_DIR=unix - name: "Linux/GCC/Debug" os: linux - dist: bionic + dist: focal compiler: gcc env: - BUILD_DIR=unix - CFGOPT="--enable-symbols" - name: "Linux/GCC/Mem-Debug" os: linux - dist: bionic + dist: focal compiler: gcc env: - BUILD_DIR=unix @@ -63,7 +63,7 @@ jobs: # Older versions of GCC... - name: "Linux/GCC 7/Shared" os: linux - dist: bionic + dist: focal compiler: gcc-7 addons: apt: @@ -75,7 +75,7 @@ jobs: - BUILD_DIR=unix - name: "Linux/GCC 6/Shared" os: linux - dist: bionic + dist: focal compiler: gcc-6 addons: apt: @@ -87,7 +87,7 @@ jobs: - BUILD_DIR=unix - name: "Linux/GCC 5/Shared" os: linux - dist: bionic + dist: focal compiler: gcc-5 addons: apt: @@ -100,27 +100,27 @@ jobs: # Clang - name: "Linux/Clang/Shared" os: linux - dist: bionic + dist: focal compiler: clang env: - BUILD_DIR=unix - name: "Linux/Clang/Static" os: linux - dist: bionic + dist: focal compiler: clang env: - CFGOPT="--disable-shared" - BUILD_DIR=unix - name: "Linux/Clang/Debug" os: linux - dist: bionic + dist: focal compiler: clang env: - BUILD_DIR=unix - CFGOPT="--enable-symbols" - name: "Linux/Clang/Mem-Debug" os: linux - dist: bionic + dist: focal compiler: clang env: - BUILD_DIR=unix @@ -174,7 +174,7 @@ jobs: # Doesn't run tests because wine is only an imperfect Windows emulation - name: "Linux-cross-Windows/GCC/Shared/no test" os: linux - dist: bionic + dist: focal compiler: x86_64-w64-mingw32-gcc env: - BUILD_DIR=win @@ -188,7 +188,7 @@ jobs: # Doesn't run tests because wine is only an imperfect Windows emulation - name: "Linux-cross-Windows-32/GCC/Shared/no test" os: linux - dist: bionic + dist: focal compiler: i686-w64-mingw32-gcc env: - BUILD_DIR=win -- cgit v0.12 From 5f4ef0229dcf7281043e2ece43b807f55ae0c461 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 24 Aug 2020 10:19:49 +0000 Subject: Backport improvemenets in .gitignore .fossil-settings/ignore-glob and win/nmakehlp.c --- .fossil-settings/ignore-glob | 4 ++ .gitignore | 3 + win/nmakehlp.c | 131 ++++++++++++++++++++++++++++++++++++++----- 3 files changed, 125 insertions(+), 13 deletions(-) diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob index eca9bcd..651d616 100644 --- a/.fossil-settings/ignore-glob +++ b/.fossil-settings/ignore-glob @@ -1,9 +1,12 @@ *.a *.dll *.dylib +*.dylib.E *.exe *.exp +*.la *.lib +*.lo *.o *.obj *.pdb @@ -61,4 +64,5 @@ win/*.manifest win/pkgs/* win/coffbase.txt win/tcl.hpj +win/nmakehlp.out win/nmhlp-out.txt diff --git a/.gitignore b/.gitignore index 701419b..33579cf 100644 --- a/.gitignore +++ b/.gitignore @@ -2,6 +2,7 @@ *.bundle *.dll *.dylib +*.dylib.E *.exe *.exp *.lib @@ -14,6 +15,7 @@ .fslckout Makefile Tcl-Info.plist +Tclsh-Info.plist autom4te.cache config.cache config.log @@ -59,4 +61,5 @@ win/*.manifest win/pkgs/* win/coffbase.txt win/tcl.hpj +win/nmakehlp.out win/nmhlp-out.txt diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 821d00b..7536ede 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -14,13 +14,8 @@ #define _CRT_SECURE_NO_DEPRECATE #include -#define NO_SHLWAPI_GDI -#define NO_SHLWAPI_STREAM -#define NO_SHLWAPI_REG -#include #pragma comment (lib, "user32.lib") #pragma comment (lib, "kernel32.lib") -#pragma comment (lib, "shlwapi.lib") #include #include @@ -46,6 +41,7 @@ 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); +static int LocateDependency(const char *keyfile); static const char *GetVersionFromFile(const char *filename, const char *match, int numdots); static DWORD WINAPI ReadFromPipe(LPVOID args); @@ -171,6 +167,18 @@ main( return 2; } return QualifyPath(argv[2]); + + case 'L': + if (argc != 3) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -L keypath\n" + "Emit the fully qualified path of directory containing keypath\n" + "exitcodes: 0 == success, 1 == not found, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return LocateDependency(argv[2]); } } chars = snprintf(msg, sizeof(msg) - 1, @@ -635,7 +643,7 @@ SubstituteFile( } /* debug: dump the list */ -#ifdef _DEBUG +#ifndef NDEBUG { int n = 0; list_item_t *p = NULL; @@ -675,6 +683,17 @@ SubstituteFile( return 0; } +BOOL FileExists(LPCTSTR szPath) +{ +#ifndef INVALID_FILE_ATTRIBUTES + #define INVALID_FILE_ATTRIBUTES ((DWORD)-1) +#endif + DWORD pathAttr = GetFileAttributes(szPath); + return (pathAttr != INVALID_FILE_ATTRIBUTES && + !(pathAttr & FILE_ATTRIBUTE_DIRECTORY)); +} + + /* * QualifyPath -- * @@ -688,18 +707,104 @@ QualifyPath( const char *szPath) { char szCwd[MAX_PATH + 1]; - char szTmp[MAX_PATH + 1]; - char *p; - GetCurrentDirectory(MAX_PATH, szCwd); - while ((p = strchr(szPath, '/')) && *p) - *p = '\\'; - PathCombine(szTmp, szCwd, szPath); - PathCanonicalize(szCwd, szTmp); + + GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL); printf("%s\n", szCwd); return 0; } /* + * Implements LocateDependency for a single directory. See that command + * for an explanation. + * Returns 0 if found after printing the directory. + * Returns 1 if not found but no errors. + * Returns 2 on any kind of error + * Basically, these are used as exit codes for the process. + */ +static int LocateDependencyHelper(const char *dir, const char *keypath) +{ + HANDLE hSearch; + char path[MAX_PATH+1]; + int dirlen, keylen, ret; + WIN32_FIND_DATA finfo; + + if (dir == NULL || keypath == NULL) + return 2; /* Have no real error reporting mechanism into nmake */ + dirlen = strlen(dir); + if ((dirlen + 3) > sizeof(path)) + return 2; + strncpy(path, dir, dirlen); + strncpy(path+dirlen, "\\*", 3); /* Including terminating \0 */ + keylen = strlen(keypath); + +#if 0 /* This function is not available in Visual C++ 6 */ + /* + * Use numerics 0 -> FindExInfoStandard, + * 1 -> FindExSearchLimitToDirectories, + * as these are not defined in Visual C++ 6 + */ + hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0); +#else + hSearch = FindFirstFile(path, &finfo); +#endif + if (hSearch == INVALID_HANDLE_VALUE) + return 1; /* Not found */ + + /* Loop through all subdirs checking if the keypath is under there */ + ret = 1; /* Assume not found */ + do { + int sublen; + /* + * We need to check it is a directory despite the + * FindExSearchLimitToDirectories in the above call. See SDK docs + */ + if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0) + continue; + sublen = strlen(finfo.cFileName); + if ((dirlen+1+sublen+1+keylen+1) > sizeof(path)) + continue; /* Path does not fit, assume not matched */ + strncpy(path+dirlen+1, finfo.cFileName, sublen); + path[dirlen+1+sublen] = '\\'; + strncpy(path+dirlen+1+sublen+1, keypath, keylen+1); + if (FileExists(path)) { + /* Found a match, print to stdout */ + path[dirlen+1+sublen] = '\0'; + QualifyPath(path); + ret = 0; + break; + } + } while (FindNextFile(hSearch, &finfo)); + FindClose(hSearch); + return ret; +} + +/* + * LocateDependency -- + * + * Locates a dependency for a package. + * keypath - a relative path within the package directory + * that is used to confirm it is the correct directory. + * The search path for the package directory is currently only + * the parent and grandparent of the current working directory. + * If found, the command prints + * name_DIRPATH= + * and returns 0. If not found, does not print anything and returns 1. + */ +static int LocateDependency(const char *keypath) +{ + int i, ret; + static const char *paths[] = {"..", "..\\..", "..\\..\\.."}; + + for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) { + ret = LocateDependencyHelper(paths[i], keypath); + if (ret == 0) + return ret; + } + return ret; +} + + +/* * Local variables: * mode: c * c-basic-offset: 4 -- cgit v0.12 From 171bea3624e84c0fe616ac8bef5d7e8138bdc359 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 24 Aug 2020 14:35:37 +0000 Subject: Try another Travis build --- tests/safe-stock86.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/safe-stock86.test b/tests/safe-stock86.test index 2fbe108..ccfdd3f 100644 --- a/tests/safe-stock86.test +++ b/tests/safe-stock86.test @@ -2,8 +2,8 @@ # # This file contains tests for safe Tcl that were previously in the file # safe.test, and use files and packages of stock Tcl 8.6 to perform the tests. -# These files may be changed or disappear in future revisions of Tcl, for -# example package http 1.0 will be removed from Tcl 8.7. +# These files may be changed or disappear in future revisions of Tcl, +# for example package http 1.0 will be removed from Tcl 8.7. # # The tests are replaced in safe.tcl with tests that use files provided in the # tests directory. Test numbering is for comparison with similar tests in -- cgit v0.12 From 0d23451993cbdb14bcb0cef73c5db4a979a23648 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 25 Aug 2020 09:42:37 +0000 Subject: Keep gcc-5 and gcc-6 builds on "bionic", because "focal" doesn't have these --- .travis.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index dd86769..ad3f03a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -75,7 +75,7 @@ jobs: - BUILD_DIR=unix - name: "Linux/GCC 6/Shared" os: linux - dist: focal + dist: bionic compiler: gcc-6 addons: apt: @@ -87,7 +87,7 @@ jobs: - BUILD_DIR=unix - name: "Linux/GCC 5/Shared" os: linux - dist: focal + dist: bionic compiler: gcc-5 addons: apt: -- cgit v0.12 From 43d2fdc86c454dc83a6fe24125d0fd1188cc1bfa Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 26 Aug 2020 14:52:42 +0000 Subject: Testcase chan-io-50.1 still fails sometimes on MacOSX. So put same measures in place as in io-50.1. See: [f586089a2b] --- tests/chanio.test | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/tests/chanio.test b/tests/chanio.test index 66f4a30..10f3624 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -6380,12 +6380,16 @@ test chan-io-50.1 {testing handler deletion} -setup { set f [open $path(test1) w] chan close $f set f [open $path(test1) r] + variable z not_called + set timer [after 50 lappend z timeout] + testservicemode 0 testchannelevent $f add readable [namespace code { variable z called testchannelevent $f delete 0 }] - variable z not_called - update + testservicemode 1 + vwait z + after cancel $timer set z } -cleanup { chan close $f -- cgit v0.12 From 3b1ca15e0739a1650dbc9c0de1429299326078ee Mon Sep 17 00:00:00 2001 From: kjnash Date: Thu, 27 Aug 2020 15:50:24 +0000 Subject: Provide error message if failed load does not. --- library/safe.tcl | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/library/safe.tcl b/library/safe.tcl index 1c46978..c0a5dc6 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -1068,6 +1068,13 @@ proc ::safe::AliasLoad {slave file args} { try { return [::interp invokehidden $slave load $file $package $target] } on error msg { + # Some packages return no error message. + set msg0 "Load of binary library for package $package failed" + if {$msg eq {}} { + set msg $msg0 + } else { + set msg "$msg0: $msg" + } Log $slave $msg return -code error $msg } -- cgit v0.12 From 953e3ea89962393c4b65866feb0f3d38f4bc8b14 Mon Sep 17 00:00:00 2001 From: kjnash Date: Fri, 28 Aug 2020 01:03:23 +0000 Subject: Update safe.test for new error message. --- library/safe.tcl | 2 +- tests/safe.test | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index c0a5dc6..352b302 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -1069,7 +1069,7 @@ proc ::safe::AliasLoad {slave file args} { return [::interp invokehidden $slave load $file $package $target] } on error msg { # Some packages return no error message. - set msg0 "Load of binary library for package $package failed" + set msg0 "load of binary library for package $package failed" if {$msg eq {}} { set msg $msg0 } else { diff --git a/tests/safe.test b/tests/safe.test index bcb33d7..eba6057 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -1167,7 +1167,7 @@ test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup { interp eval $i {load {} Safepkg1} } -returnCodes error -cleanup { safe::interpDelete $i -} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} +} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup { set i [safe::interpCreate] } -body { @@ -1176,7 +1176,7 @@ test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup { } -returnCodes ok -cleanup { unset -nocomplain m o safe::interpDelete $i -} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure +} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure invoked from within "load {} Safepkg1" invoked from within @@ -1199,7 +1199,7 @@ test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints Tcl interp eval $i {interp create x; load {} Safepkg1 x} } -returnCodes error -cleanup { safe::interpDelete $i -} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} +} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body { set i [safe::interpCreate -nestedloadok] catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o @@ -1207,7 +1207,7 @@ test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints T } -returnCodes ok -cleanup { unset -nocomplain m o safe::interpDelete $i -} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure +} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure invoked from within "load {} Safepkg1 x" invoked from within -- cgit v0.12