diff options
| -rw-r--r-- | generic/tclStubInit.c | 2 | ||||
| -rw-r--r-- | tests/fCmd.test | 18 | ||||
| -rw-r--r-- | tests/http.test | 11 | ||||
| -rw-r--r-- | tests/httpd | 10 | ||||
| -rw-r--r-- | unix/Makefile.in | 13 | ||||
| -rw-r--r-- | win/tclWinFile.c | 18 | ||||
| -rw-r--r-- | win/tclWinInit.c | 3 | ||||
| -rw-r--r-- | win/tclWinInt.h | 1 |
8 files changed, 52 insertions, 24 deletions
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 6091ae8..9d4708e 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -232,7 +232,7 @@ mp_err TclBN_mp_div_ld(const mp_int *a, uint64_t b, mp_int *c, uint64_t *d) { if ((b | (mp_digit)-1) != (mp_digit)-1) { return MP_VAL; } - result = mp_div_d(a, b, c, (d ? &d2 : NULL)); + result = mp_div_d(a, (mp_digit)b, c, (d ? &d2 : NULL)); if (d) { *d = d2; } diff --git a/tests/fCmd.test b/tests/fCmd.test index a13f0e1..004392f 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -24,6 +24,7 @@ testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testchmod [llength [info commands testchmod]] testConstraint winVista 0 testConstraint winXP 0 +testConstraint win10 0 # Don't know how to determine this constraint correctly testConstraint notNetworkFilesystem 0 testConstraint reg 0 @@ -67,9 +68,14 @@ if {[testConstraint unix]} { # Also used in winFCmd... if {[testConstraint win]} { if {$::tcl_platform(osVersion) >= 5.0} { - testConstraint winVista 1 - } else { - testConstraint winXP 1 + if {$::tcl_platform(osVersion) >= 10.0} { + testConstraint win10 1 + } + if {$::tcl_platform(osVersion) >= 6.0} { + testConstraint winVista 1 + } else { + testConstraint win2000orXP 1 + } } } @@ -2354,13 +2360,13 @@ test fCmd-28.7 {file link: source already exists} -setup { } -returnCodes error -cleanup { cd [workingDirectory] } -result {could not create new link "abc.file": that path already exists} -test fCmd-28.8 {file link} -constraints {linkFile win} -setup { +test fCmd-28.8 {file link} -constraints {linkFile win10} -setup { cd [temporaryDirectory] } -body { file link -symbolic abc.link abc.file -} -returnCodes error -cleanup { +} -cleanup { cd [workingDirectory] -} -result {could not create new link "abc.link" pointing to "abc.file": not a directory} +} -result abc.file test fCmd-28.9 {file link: success with file} -constraints {linkFile} -setup { cd [temporaryDirectory] file delete -force abc.link diff --git a/tests/http.test b/tests/http.test index 4a07789..ff9fb78 100644 --- a/tests/http.test +++ b/tests/http.test @@ -38,13 +38,10 @@ proc bgerror {args} { puts stderr $errorInfo } -if {$::tcl_platform(os) eq "Darwin"} { - # Name resolution often a problem on OSX; not focus of HTTP package anyway - set HOST localhost -} else { - set HOST [info hostname] -} - +# Do not use [info hostname]. +# Name resolution is often a problem on OSX; not focus of HTTP package anyway. +# Also a problem on other platforms for http-4.14 (test with bad port number). +set HOST localhost set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null" catch {unset data} diff --git a/tests/httpd b/tests/httpd index 37343aa..43e9372 100644 --- a/tests/httpd +++ b/tests/httpd @@ -10,12 +10,10 @@ #set httpLog 1 -if {$::tcl_platform(os) eq "Darwin"} { - # Name resolution often a problem on OSX; not focus of HTTP package anyway - set HOST localhost -} else { - set HOST [info hostname] -} +# Do not use [info hostname]. +# Name resolution is often a problem on OSX; not focus of HTTP package anyway. +# Also a problem on other platforms for http-4.14 (test with bad port number). +set HOST localhost proc httpd_init {{port 8015}} { set s [socket -server httpdAccept $port] diff --git a/unix/Makefile.in b/unix/Makefile.in index 4d37704..7493f99 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -2290,6 +2290,19 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in gen cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \ $(DISTDIR)/tests + @mkdir $(DISTDIR)/tests/auto0 + for i in auto1 auto2 ; \ + do \ + mkdir $(DISTDIR)/tests/auto0/$$i ;\ + cp -p $(TOP_DIR)/tests/auto0/$$i/tclIndex $(TOP_DIR)/tests/auto0/$$i/*.tcl \ + $(DISTDIR)/tests/auto0/$$i; \ + done; + for i in modules modules/mod1 modules/mod2 ; \ + do \ + mkdir $(DISTDIR)/tests/auto0/$$i ;\ + cp -p $(TOP_DIR)/tests/auto0/$$i/*.tm \ + $(DISTDIR)/tests/auto0/$$i; \ + done; @mkdir $(DISTDIR)/win cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win cp $(TOP_DIR)/win/configure.ac $(TOP_DIR)/win/configure \ diff --git a/win/tclWinFile.c b/win/tclWinFile.c index f51d6f5..38edd87 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -264,11 +264,21 @@ WinLink( TclWinConvertError(GetLastError()); } else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { - /* - * Can't symlink files. - */ + if (!tclWinProcs.createSymbolicLink) { + /* + * Can't symlink files. + */ + Tcl_SetErrno(ENOTDIR); + } else if (tclWinProcs.createSymbolicLink(linkSourcePath, linkTargetPath, + 0x2 /* SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE */)) { + /* + * Success! + */ - Tcl_SetErrno(ENOTDIR); + return 0; + } + + TclWinConvertError(GetLastError()); } else { Tcl_SetErrno(ENODEV); } diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 29393ce..a7fb8d0 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -158,6 +158,9 @@ TclpInitPlatform(void) tclWinProcs.cancelSynchronousIo = (BOOL (WINAPI *)(HANDLE))(void *)GetProcAddress(handle, "CancelSynchronousIo"); + tclWinProcs.createSymbolicLink = + (BOOLEAN (WINAPI *)(LPCWSTR, LPCWSTR, DWORD))(void *)GetProcAddress(handle, + "CreateSymbolicLinkW"); } /* diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 3b31d8a..90a6cea 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -36,6 +36,7 @@ typedef struct TCLEXCEPTION_REGISTRATION { */ typedef struct TclWinProcs { BOOL (WINAPI *cancelSynchronousIo)(HANDLE); + BOOLEAN (WINAPI *createSymbolicLink)(LPCWSTR, LPCWSTR, DWORD); } TclWinProcs; MODULE_SCOPE TclWinProcs tclWinProcs; |