diff options
| -rw-r--r-- | .github/workflows/linux-build.yml | 2 | ||||
| -rw-r--r-- | .github/workflows/mac-build.yml | 2 | ||||
| -rw-r--r-- | .github/workflows/onefiledist.yml | 2 | ||||
| -rw-r--r-- | .github/workflows/win-build.yml | 2 | ||||
| -rw-r--r-- | generic/tclDecls.h | 11 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 4 | ||||
| -rw-r--r-- | tests/string.test | 43 | ||||
| -rw-r--r-- | tests/utf.test | 7 | ||||
| -rw-r--r-- | win/rules.vc | 4 | ||||
| -rw-r--r-- | win/tclWinPort.h | 1 |
10 files changed, 50 insertions, 28 deletions
diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml index c365faa..f5edb60 100644 --- a/.github/workflows/linux-build.yml +++ b/.github/workflows/linux-build.yml @@ -1,5 +1,7 @@ name: Linux on: [push] +permissions: + contents: read jobs: gcc: runs-on: ubuntu-20.04 diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml index 30c16af..5077bf3 100644 --- a/.github/workflows/mac-build.yml +++ b/.github/workflows/mac-build.yml @@ -1,5 +1,7 @@ name: macOS on: [push] +permissions: + contents: read jobs: xcode: runs-on: macos-11 diff --git a/.github/workflows/onefiledist.yml b/.github/workflows/onefiledist.yml index 8bd8ed2..95c6b82 100644 --- a/.github/workflows/onefiledist.yml +++ b/.github/workflows/onefiledist.yml @@ -1,5 +1,7 @@ name: Build Binaries on: [push] +permissions: + contents: read jobs: linux: name: Linux diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml index e3c991e..6eb1694 100644 --- a/.github/workflows/win-build.yml +++ b/.github/workflows/win-build.yml @@ -1,5 +1,7 @@ name: Windows on: [push] +permissions: + contents: read env: ERROR_ON_FAILURES: 1 jobs: diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 4c8e13b..6e08f9f 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4325,6 +4325,17 @@ extern const TclStubs *tclStubsPtr; # define Tcl_UtfToUniChar Tcl_UtfToChar16 # undef Tcl_UniCharLen # define Tcl_UniCharLen Tcl_Char16Len +#elif !defined(BUILD_tcl) +# undef Tcl_NumUtfChars +# define Tcl_NumUtfChars TclNumUtfChars +# undef Tcl_GetCharLength +# define Tcl_GetCharLength TclGetCharLength +# undef Tcl_UtfAtIndex +# define Tcl_UtfAtIndex TclUtfAtIndex +# undef Tcl_GetRange +# define Tcl_GetRange TclGetRange +# undef Tcl_GetUniChar +# define Tcl_GetUniChar TclGetUniChar #endif #if defined(USE_TCL_STUBS) # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 7d04481..fd06c14 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -78,8 +78,11 @@ #undef Tcl_MacOSXOpenBundleResources #undef TclWinConvertWSAError #undef TclWinConvertError +#undef Tcl_NumUtfChars #undef Tcl_GetCharLength #undef Tcl_UtfAtIndex +#undef Tcl_GetRange +#undef Tcl_GetUniChar #if defined(_WIN32) || defined(__CYGWIN__) #define TclWinConvertWSAError (void (*)(DWORD))(void *)Tcl_WinConvertError @@ -103,6 +106,7 @@ static void uniCodePanic(void) { # define Tcl_UniCharCaseMatch (int(*)(const unsigned short *, const unsigned short *, int))(void *)uniCodePanic # define Tcl_GetRange (Tcl_Obj *(*)(Tcl_Obj *, int, int))(void *)uniCodePanic # define Tcl_GetUniChar (int(*)(Tcl_Obj *, int))(void *)uniCodePanic +# define Tcl_NumUtfChars (int(*)(const char *, int))(void *)uniCodePanic #endif #define TclUtfCharComplete UtfCharComplete diff --git a/tests/string.test b/tests/string.test index 6863c23..1a48d97 100644 --- a/tests/string.test +++ b/tests/string.test @@ -366,7 +366,6 @@ test string-3.42.$noComp {string equal, binary neq inequal length} { run {string equal [binary format a20a 0 1] [binary format a100a 0 0]} } 0 - test string-4.1.$noComp {string first, not enough args} { list [catch {run {string first a}} msg] $msg } {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}} @@ -425,22 +424,22 @@ test string-4.16.$noComp {string first, normal string vs pure unicode string} -b } -match glob -result {{*string 1} {*string 0} 2} test string-4.17.$noComp {string first, corner case} -body { run {string first a aaa 4294967295} -} -result {-1} +} -result -1 test string-4.18.$noComp {string first, corner case} -body { run {string first a aaa -1} -} -result {0} +} -result 0 test string-4.19.$noComp {string first, corner case} -body { run {string first a aaa end-5} -} -result {0} +} -result 0 test string-4.20.$noComp {string last, corner case} -body { run {string last a aaa 4294967295} -} -result {2} +} -result 2 test string-4.21.$noComp {string last, corner case} -body { run {string last a aaa -1} -} -result {-1} +} -result -1 test string-4.22.$noComp {string last, corner case} { run {string last a aaa end-5} -} {-1} +} -1 test string-5.1.$noComp {string index} { list [catch {run {string index}} msg] $msg @@ -1085,13 +1084,13 @@ test string-10.3.$noComp {string map, too many args} { } {1 {wrong # args: should be "string map ?-nocase? charMap string"}} test string-10.4.$noComp {string map} { run {string map {a b} abba} -} {bbbb} +} bbbb test string-10.5.$noComp {string map} { run {string map {a b} a} -} {b} +} b test string-10.6.$noComp {string map -nocase} { run {string map -nocase {a b} Abba} -} {bbbb} +} bbbb test string-10.7.$noComp {string map} { run {string map {abc 321 ab * a A} aabcabaababcab} } {A321*A*321*} @@ -1106,7 +1105,7 @@ test string-10.10.$noComp {string map} { } {1 {char map list unbalanced}} test string-10.11.$noComp {string map, nulls} { run {string map {\x00 NULL blah \x00nix} {qwerty}} -} {qwerty} +} qwerty test string-10.12.$noComp {string map, unicode} { run {string map [list ü ue UE Ü] "aüueUE\x00EU"} } aueueÜ\x00EU @@ -1118,13 +1117,13 @@ test string-10.14.$noComp {string map, -nocase null arguments} { } foo test string-10.15.$noComp {string map, one pair case} { run {string map -nocase {abc 32} aAbCaBaAbAbcAb} -} {a32aBaAb32Ab} +} a32aBaAb32Ab test string-10.16.$noComp {string map, one pair case} { run {string map -nocase {ab 4321} aAbCaBaAbAbcAb} -} {a4321C4321a43214321c4321} +} a4321C4321a43214321c4321 test string-10.17.$noComp {string map, one pair case} { run {string map {Ab 4321} aAbCaBaAbAbcAb} -} {a4321CaBa43214321c4321} +} a4321CaBa43214321c4321 test string-10.18.$noComp {string map, empty argument} { run {string map -nocase {{} abc} foo} } foo @@ -1596,22 +1595,22 @@ test string-14.5.$noComp {string replace} { } {abp} test string-14.6.$noComp {string replace} -body { run {string replace abcdefghijklmnop 7 1000} -} -result {abcdefg} +} -result abcdefg test string-14.7.$noComp {string replace} { run {string replace abcdefghijklmnop 10 end} -} {abcdefghij} +} abcdefghij test string-14.8.$noComp {string replace} { run {string replace abcdefghijklmnop 10 9} -} {abcdefghijklmnop} +} abcdefghijklmnop test string-14.9.$noComp {string replace} { run {string replace abcdefghijklmnop -3 2} -} {defghijklmnop} +} defghijklmnop test string-14.10.$noComp {string replace} { run {string replace abcdefghijklmnop -3 -2} -} {abcdefghijklmnop} +} abcdefghijklmnop test string-14.11.$noComp {string replace} -body { run {string replace abcdefghijklmnop 1000 1010} -} -result {abcdefghijklmnop} +} -result abcdefghijklmnop test string-14.12.$noComp {string replace} { run {string replace abcdefghijklmnop -100 end} } {} @@ -1858,7 +1857,7 @@ test string-20.5.$noComp {string trimright} { test string-20.6.$noComp {string trimright, unicode default} { run {string trimright ABC\u1361\x85\x00\xA0\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000} } ABC\u1361 -test string-20.7.$noComp {string trim on not valid utf-8 sequence (consider NTS as continuation char), bug [c61818e4c9]} {testbytestring} { +test string-20.7.$noComp {string trim on not valid utf-8 sequence (consider NTS as continuation char), bug [c61818e4c9]} testbytestring { set result {} set a [testbytestring \xC0\x80\xA0] set b foo$a @@ -1871,7 +1870,7 @@ test string-20.7.$noComp {string trim on not valid utf-8 sequence (consider NTS lappend result [string map $m [run {string trim $b fox}]] lappend result [string map $m [run {string trim $b fo\x00}]] } [list {*}[lrepeat 3 fooUV] {*}[lrepeat 2 UV V]] -test string-20.8.$noComp {[c61818e4c9] [string trimright] fails when UtfPrev is ok} {testbytestring} { +test string-20.8.$noComp {[c61818e4c9] [string trimright] fails when UtfPrev is ok} testbytestring { set result {} set a [testbytestring \xE8\xA0] set b foo$a diff --git a/tests/utf.test b/tests/utf.test index c0d64e2..60596f7 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -16,6 +16,8 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] +package require tcltests + testConstraint ucs2 [expr {[format %c 0x010000] eq "\uFFFD"}] testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}] testConstraint utf16 [expr {[string length [format %c 0x10000]] == 2}] @@ -191,12 +193,9 @@ test utf-4.10 {Tcl_NumUtfChars: #x00, calc len, overcomplete} {testnumutfchars t test utf-4.11 {Tcl_NumUtfChars: 3 bytes of 4-byte UTF-8 characater} {testnumutfchars testbytestring} { testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end-1 } 3 -test utf-4.12.0 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring ucs2} { +test utf-4.12 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring deprecated} { testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end } 2 -test utf-4.12.1 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring utf32} { - testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end -} 1 test utf-4.13 {Tcl_NumUtfChars: end of string} {testnumutfchars testbytestring} { testnumutfchars foobar[testbytestring \xF2\xC2\xA0] end } 8 diff --git a/win/rules.vc b/win/rules.vc index 3107756..47c0742 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -1470,8 +1470,8 @@ cdebug = $(cdebug) -Zi !endif # $(DEBUG)
-# cwarn includes default warning levels, also C4146 is useless.
-cwarn = $(WARNINGS) -wd4146
+# cwarn includes default warning levels, also C4090 (buggy) and C4146 is useless.
+cwarn = $(WARNINGS) -wd4090 -wd4146
!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64"
# Disable pointer<->int warnings related to cast between different sizes
diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 455ceab..b61e481 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -458,6 +458,7 @@ typedef DWORD_PTR * PDWORD_PTR; #endif /* _MSC_VER || __MSVCRT__ */ #if defined(_MSC_VER) +# pragma warning(disable:4090) /* see: https://developercommunity.visualstudio.com/t/c-compiler-incorrect-propagation-of-const-qualifie/390711 */ # pragma warning(disable:4146) # pragma warning(disable:4244) # pragma warning(disable:4267) |