Add "cluster" testcases, and make them pass in all environments

7 files changed, 174 insertions, 17 deletions

diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml
index b5198e0..3bdb827 100644
--- a/.github/workflows/linux-build.yml
+++ b/.github/workflows/linux-build.yml
@@ -118,7 +118,7 @@ jobs:
           path: tk
       - name: Setup Environment (compiler=${{ matrix.compiler }})
         run: |
-          sudo apt-get install tcl8.6-dev libxss-dev xvfb
+          sudo apt-get install tcl8.6-dev libxss-dev xvfb libicu-dev
           mkdir "$HOME/install dir"
           touch tk/doc/man.macros tk/generic/tkStubInit.c
           echo "CFGOPT=$CFGOPT --with-tcl=/usr/lib/tcl8.6 --disable-zipfs" >> $GITHUB_ENV
diff --git a/.github/workflows/linux-with-tcl8-build.yml b/.github/workflows/linux-with-tcl8-build.yml
index 4e56b64..eb61eee 100644
--- a/.github/workflows/linux-with-tcl8-build.yml
+++ b/.github/workflows/linux-with-tcl8-build.yml
@@ -137,7 +137,7 @@ jobs:
           path: tcl
       - name: Setup Environment (compiler=${{ matrix.compiler }})
         run: |
-          sudo apt-get install libxss-dev xvfb
+          sudo apt-get install libxss-dev xvfb libicu-dev
           mkdir "$HOME/install dir"
           touch tk/doc/man.macros tk/generic/tkStubInit.c
           echo "CFGOPT=$CFGOPT" >> $GITHUB_ENV
diff --git a/.github/workflows/linux-with-tcl9-build.yml b/.github/workflows/linux-with-tcl9-build.yml
index 5335708..37ff390 100644
--- a/.github/workflows/linux-with-tcl9-build.yml
+++ b/.github/workflows/linux-with-tcl9-build.yml
@@ -137,7 +137,7 @@ jobs:
           path: tcl
       - name: Setup Environment (compiler=${{ matrix.compiler }})
         run: |
-          sudo apt-get install libxss-dev xvfb
+          sudo apt-get install libxss-dev xvfb libicu-dev
           mkdir "$HOME/install dir"
           touch tk/doc/man.macros tk/generic/tkStubInit.c
           echo "CFGOPT=$CFGOPT" >> $GITHUB_ENV
diff --git a/generic/tkIcu.c b/generic/tkIcu.c
index 69f3c00..7c8e066 100644
--- a/generic/tkIcu.c
+++ b/generic/tkIcu.c
@@ -82,6 +82,7 @@ startEndOfCmd(
     void *it;
     TkSizeT idx;
     int flags = PTR2INT(clientData);
+    const uint16_t *ustr;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1 , objv, "str start");
@@ -102,7 +103,8 @@ startEndOfCmd(
     		NULL, -1, &errorCode);
     if (it != NULL) {
 	errorCode = U_ZERO_ERRORZ;
-	icu_setText(it, (const uint16_t *)Tcl_DStringValue(&ds), len, &errorCode);
+	ustr = (const uint16_t *)Tcl_DStringValue(&ds);
+	icu_setText(it, ustr, len, &errorCode);
     }
     if (it == NULL || errorCode != U_ZERO_ERRORZ) {
     	Tcl_DStringFree(&ds);
@@ -111,16 +113,34 @@ startEndOfCmd(
     	return TCL_ERROR;
     }
     if (flags & FLAG_FOLLOWING) {
+	if ((idx == TCL_INDEX_NONE) && (flags & FLAG_WORD)) {
+	    idx = 0;
+	}
 	idx = icu_following(it, idx);
-    } else {
-	idx = icu_preceding(it, idx + 1);
+	if ((flags & FLAG_WORD) && idx >= len) {
+	    idx = -1;
+	}
+    } else if (idx > 0) {
+	if (!(flags & FLAG_WORD)) {
+		idx += 1 + (((ustr[idx]&0xFFC0) == 0xD800) && ((ustr[idx+1]&0xFFC0) == 0xDC00));
+	}
+	idx = icu_preceding(it, idx);
+	if (idx == 0 && (flags & FLAG_WORD)) {
+	    flags &= ~FLAG_WORD; /* If 0 is reached here, don't do a further search */
+	}
     }
-    if ((flags & FLAG_WORD) && (idx != (TkSizeT)-1) && !(flags & FLAG_SPACE) ==
-	    ((idx >= len) || Tcl_UniCharIsSpace(((const uint16_t *)Tcl_DStringValue(&ds))[idx]))) {
-	if (flags & FLAG_FOLLOWING) {
-	    idx = icu_next(it);
-	} else {
-	    idx = icu_previous(it);
+    if ((flags & FLAG_WORD) && (idx != TCL_INDEX_NONE)) {
+	if (!(flags & FLAG_SPACE) == ((idx >= len) || Tcl_UniCharIsSpace(ustr[idx]))) {
+	    if (flags & FLAG_FOLLOWING) {
+		idx = icu_next(it);
+		if (idx >= len) {
+		    idx = -1;
+		}
+	    } else {
+		idx = icu_previous(it);
+	    }
+	} else if (idx == 0 && !(flags & FLAG_FOLLOWING)) {
+	    idx = -1;
 	}
     }
     Tcl_SetObjResult(interp, TkNewIndexObj(idx));
diff --git a/library/tk.tcl b/library/tk.tcl
index 6828465..6571b0d 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -718,8 +718,10 @@ if {[info commands ::tk::startOfPreviousWord] eq ""} {
 }
 if {[info commands ::tk::endOfCluster] eq ""} {
     proc ::tk::endOfCluster {str start} {
-	if {$start >= [string length $str]} {
-	    return -1;
+	if {$start eq "end"} {
+	    return [string length $str]
+	} elseif {$start >= [string length $str]} {
+	    return -1
 	}
 	if {[string length [string index $str $start]] > 1} {
 	    set start [expr {$start+1}]
@@ -732,9 +734,14 @@ if {[info commands ::tk::startOfCluster] eq ""} {
     proc ::tk::startOfCluster {str start} {
 	if {$start eq "end"} {
 	    set start [expr {[string length $str]-1}]
+	} elseif {$start >= [string length $str]} {
+	    return [string length $str]
+	}
+	if {[string length [string index $str $start]] < 1} {
+	    set start [expr {$start-1}]
 	}
 	if {$start < 0} {
-	    return -1;
+	    return -1
 	}
 	return $start
     }
diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c
index 7cfd023..e775091 100644
--- a/macosx/tkMacOSXFont.c
+++ b/macosx/tkMacOSXFont.c
@@ -482,8 +482,9 @@ startOfClusterObjCmd(
     }
     if (indexArg == TCL_INDEX_NONE) {
 	Tcl_SetObjResult(interp, TkNewIndexObj(TCL_INDEX_NONE));
+	return TCL_OK;
     } else if ((size_t)indexArg >= [S length]) {
-	Tcl_SetObjResult(interp, TkNewIndexObj([S length]));
+	Tcl_SetObjResult(interp, TkNewIndexObj((TkSizeT)[S length]));
 	return TCL_OK;
     }
     result = [S startOfCluster:indexArg];
@@ -524,7 +525,7 @@ endOfClusterObjCmd(
 	result = 0;
     } else {
 	result = (size_t)indexArg < [S length] ?
-		[S endOfCluster:indexArg] : [S length];
+		[S endOfCluster:indexArg] : -1;
     }
     Tcl_SetObjResult(interp, TkNewIndexObj(result));
     return TCL_OK;
diff --git a/tests/cluster.test b/tests/cluster.test
new file mode 100644
index 0000000..14e8677
--- /dev/null
+++ b/tests/cluster.test
@@ -0,0 +1,129 @@
+# This file is a Tcl script to test the [::tk::startOf|endOf]* functions in
+# tk.tcl and tkIcu.c.  It is organized in the standard fashion for Tcl tests.
+#
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1995 Sun Microsystems, Inc.
+# Copyright © 1998-1999 Scriptics Corporation.
+# All rights reserved.
+
+package require tcltest 2.2
+eval tcltest::configure $argv
+tcltest::loadTestedCommands
+namespace import -force tcltest::test
+
+test cluster-1.0 {::tk::startOfCluster} -body {
+    ::tk::startOfCluster 🤡 -1
+} -result -1
+test cluster-1.1 {::tk::startOfCluster} -body {
+    ::tk::startOfCluster 🤡 0
+} -result 0
+test cluster-1.2 {::tk::startOfCluster} -body {
+    ::tk::startOfCluster 🤡 1
+} -result 0
+test cluster-1.3 {::tk::startOfCluster} -body {
+    ::tk::startOfCluster 🤡 2
+} -result 2
+test cluster-1.3 {::tk::startOfCluster} -body {
+    ::tk::startOfCluster 🤡 3
+} -result 2
+test cluster-1.3 {::tk::startOfCluster} -body {
+    ::tk::startOfCluster 🤡 end
+} -result 0
+
+test cluster-2.0 {::tk::endOfCluster} -body {
+    ::tk::endOfCluster 🤡 -1
+} -result 0
+test cluster-2.1 {::tk::endOfCluster} -body {
+    ::tk::endOfCluster 🤡 0
+} -result 2
+test cluster-2.2 {::tk::endOfCluster} -body {
+    ::tk::endOfCluster 🤡 1
+} -result 2
+test cluster-2.3 {::tk::endOfCluster} -body {
+    ::tk::endOfCluster 🤡 2
+} -result -1
+test cluster-2.4 {::tk::endOfCluster} -body {
+    ::tk::endOfCluster 🤡 3
+} -result -1
+test cluster-2.5 {::tk::endOfCluster} -body {
+    ::tk::endOfCluster 🤡 end
+} -result 2
+
+test cluster-3.0 {::tk::endOfWord} -body {
+    ::tk::endOfWord "ab cd" -1
+} -result 2
+test cluster-3.1 {::tk::endOfWord} -body {
+    ::tk::endOfWord "ab cd" 0
+} -result 2
+test cluster-3.2 {::tk::endOfWord} -body {
+    ::tk::endOfWord "ab cd" 1
+} -result 2
+test cluster-3.3 {::tk::endOfWord} -body {
+    ::tk::endOfWord "ab cd" 2
+} -result -1
+test cluster-3.4 {::tk::endOfWord} -body {
+    ::tk::endOfWord "ab cd" 3
+} -result -1
+test cluster-3.5 {::tk::endOfWord} -body {
+    ::tk::endOfWord "ab cd" 4
+} -result -1
+test cluster-3.6 {::tk::endOfWord} -body {
+    ::tk::endOfWord "ab cd" 5
+} -result -1
+test cluster-3.7 {::tk::endOfWord} -body {
+    ::tk::endOfWord "ab cd" end
+} -result -1
+
+test cluster-4.0 {::tk::startOfPreviousWord} -body {
+    ::tk::startOfPreviousWord "ab cd" -1
+} -result -1
+test cluster-4.1 {::tk::startOfPreviousWord} -body {
+    ::tk::startOfPreviousWord "ab cd" 0
+} -result -1
+test cluster-4.2 {::tk::startOfPreviousWord} -body {
+    ::tk::startOfPreviousWord "ab cd" 1
+} -result 0
+test cluster-4.3 {::tk::startOfPreviousWord} -body {
+    ::tk::startOfPreviousWord "ab cd" 2
+} -result 0
+test cluster-4.4 {::tk::startOfPreviousWord} -body {
+    ::tk::startOfPreviousWord "ab cd" 3
+} -result 0
+test cluster-4.5 {::tk::startOfPreviousWord} -body {
+    ::tk::startOfPreviousWord "ab cd" 4
+} -result 3
+test cluster-4.6 {::tk::startOfPreviousWord} -body {
+    ::tk::startOfPreviousWord "ab cd" 5
+} -result 3
+test cluster-4.7 {::tk::startOfPreviousWord} -body {
+    ::tk::startOfPreviousWord "ab cd" end
+} -result 3
+
+test cluster-5.0 {::tk::startOfNextWord} -body {
+    ::tk::startOfNextWord "ab cd" -1
+} -result 3
+test cluster-5.1 {::tk::startOfNextWord} -body {
+    ::tk::startOfNextWord "ab cd" 0
+} -result 3
+test cluster-5.2 {::tk::startOfNextWord} -body {
+    ::tk::startOfNextWord "ab cd" 1
+} -result 3
+test cluster-5.3 {::tk::startOfNextWord} -body {
+    ::tk::startOfNextWord "ab cd" 2
+} -result 3
+test cluster-5.4 {::tk::startOfNextWord} -body {
+    ::tk::startOfNextWord "ab cd" 3
+} -result -1
+test cluster-5.5 {::tk::startOfNextWord} -body {
+    ::tk::startOfNextWord "ab cd" 4
+} -result -1
+test cluster-5.6 {::tk::startOfNextWord} -body {
+    ::tk::startOfNextWord "ab cd" 5
+} -result -1
+test cluster-5.7 {::tk::startOfNextWord} -body {
+    ::tk::startOfNextWord "ab cd" end
+} -result -1
+
+
+cleanupTests
+return