Improve tcl_startOfPreviousWord, so it can handle indices like "" (from Tk) and "end-1"

2 files changed, 207 insertions, 2 deletions

diff --git a/library/word.tcl b/library/word.tcl
index e86c44a..5b6131d 100644
--- a/library/word.tcl
+++ b/library/word.tcl
@@ -65,6 +65,9 @@ namespace eval ::tcl {
 proc tcl_wordBreakAfter {str start} {
     variable ::tcl::WordBreakRE
     set result {-1 -1}
+    if {$start < 0} {
+	set start 0;
+    }
     regexp -indices -start $start -- $WordBreakRE(after) $str result
     return [lindex $result 1]
 }
@@ -83,7 +86,9 @@ proc tcl_wordBreakAfter {str start} {
 proc tcl_wordBreakBefore {str start} {
     variable ::tcl::WordBreakRE
     set result {-1 -1}
-    regexp -indices -- $WordBreakRE(before) [string range $str 0 $start] result
+    if {$start >= 0} {
+	regexp -indices -- $WordBreakRE(before) [string range $str 0 $start] result
+    }
     return [lindex $result 1]
 }
 
@@ -102,6 +107,9 @@ proc tcl_wordBreakBefore {str start} {
 proc tcl_endOfWord {str start} {
     variable ::tcl::WordBreakRE
     set result {-1 -1}
+    if {$start < 0} {
+	set start 0
+    }
     regexp -indices -start $start -- $WordBreakRE(end) $str result
     return [lindex $result 1]
 }
@@ -120,6 +128,9 @@ proc tcl_endOfWord {str start} {
 proc tcl_startOfNextWord {str start} {
     variable ::tcl::WordBreakRE
     set result {-1 -1}
+    if {$start < 0} {
+	set start 0
+    }
     regexp -indices -start $start -- $WordBreakRE(next) $str result
     return [lindex $result 1]
 }
@@ -137,7 +148,7 @@ proc tcl_startOfPreviousWord {str start} {
     variable ::tcl::WordBreakRE
     set word {-1 -1}
     if {$start > 0} {
-	regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \
+	regexp -indices -- $WordBreakRE(previous) [string range [string range $str 0 $start] 0 end-1]\
 		result word
     }
     return [lindex $word 0]
diff --git a/tests/word.test b/tests/word.test
new file mode 100644
index 0000000..8e5bac5
--- /dev/null
+++ b/tests/word.test
@@ -0,0 +1,194 @@
+# This file is a Tcl script to test the [tcl_startOf|endOf]* functions in
+# word.tcl.  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.
+
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2.5
+    namespace import -force ::tcltest::*
+}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact tcl::test [info patchlevel]]
+
+test word-3.0 {tcl_endOfWord} -body {
+    tcl_endOfWord "ab cd" -1
+} -result 2
+test word-3.1 {tcl_endOfWord} -body {
+    tcl_endOfWord "ab cd" 0
+} -result 2
+test word-3.2 {tcl_endOfWord} -body {
+    tcl_endOfWord "ab cd" 1
+} -result 2
+test word-3.3 {tcl_endOfWord} -body {
+    tcl_endOfWord "ab cd" 2
+} -result -1
+test word-3.4 {tcl_endOfWord} -body {
+    tcl_endOfWord "ab cd" 3
+} -result -1
+test word-3.5 {tcl_endOfWord} -body {
+    tcl_endOfWord "ab cd" 4
+} -result -1
+test word-3.6 {tcl_endOfWord} -body {
+    tcl_endOfWord "ab cd" 5
+} -result -1
+test word-3.7 {tcl_endOfWord} -body {
+    tcl_endOfWord "ab cd" end
+} -result -1
+test word-3.8 {tcl_endOfWord} -body {
+    tcl_endOfWord "ab cd" {}
+} -result 2
+test word-3.9 {tcl_endOfWord} -body {
+    tcl_endOfWord "ab cd" end-1
+} -result -1
+
+test word-4.0 {tcl_startOfPreviousWord} -body {
+    tcl_startOfPreviousWord "ab cd" -1
+} -result -1
+test word-4.1 {tcl_startOfPreviousWord} -body {
+    tcl_startOfPreviousWord "ab cd" 0
+} -result -1
+test word-4.2 {tcl_startOfPreviousWord} -body {
+    tcl_startOfPreviousWord "ab cd" 1
+} -result 0
+test word-4.3 {tcl_startOfPreviousWord} -body {
+    tcl_startOfPreviousWord "ab cd" 2
+} -result 0
+test word-4.4 {tcl_startOfPreviousWord} -body {
+    tcl_startOfPreviousWord "ab cd" 3
+} -result 0
+test word-4.5 {tcl_startOfPreviousWord} -body {
+    tcl_startOfPreviousWord "ab cd" 4
+} -result 3
+test word-4.6 {tcl_startOfPreviousWord} -body {
+    tcl_startOfPreviousWord "ab cd" 5
+} -result 3
+test word-4.7 {tcl_startOfPreviousWord} -body {
+    tcl_startOfPreviousWord "ab cd" end
+} -result 3
+test word-4.8 {tcl_startOfPreviousWord} -body {
+    tcl_startOfPreviousWord "ab cd" {}
+} -result -1
+test word-4.9 {tcl_startOfPreviousWord} -body {
+    tcl_startOfPreviousWord "ab cd" end-1
+} -result 0
+
+test word-5.0 {tcl_startOfNextWord} -body {
+    tcl_startOfNextWord "ab cd" -1
+} -result 3
+test word-5.1 {tcl_startOfNextWord} -body {
+    tcl_startOfNextWord "ab cd" 0
+} -result 3
+test word-5.2 {tcl_startOfNextWord} -body {
+    tcl_startOfNextWord "ab cd" 1
+} -result 3
+test word-5.3 {tcl_startOfNextWord} -body {
+    tcl_startOfNextWord "ab cd" 2
+} -result 3
+test word-5.4 {tcl_startOfNextWord} -body {
+    tcl_startOfNextWord "ab cd" 3
+} -result -1
+test word-5.5 {tcl_startOfNextWord} -body {
+    tcl_startOfNextWord "ab cd" 4
+} -result -1
+test word-5.6 {tcl_startOfNextWord} -body {
+    tcl_startOfNextWord "ab cd" 5
+} -result -1
+test word-5.7 {tcl_startOfNextWord} -body {
+    tcl_startOfNextWord "ab cd" end
+} -result -1
+test word-5.8 {tcl_startOfNextWord} -body {
+    tcl_startOfNextWord "ab cd" {}
+} -result 3
+test word-5.9 {tcl_startOfNextWord} -body {
+    tcl_startOfNextWord "ab cd" end-1
+} -result -1
+
+test word-6.0 {tcl_wordBreakBefore} -body {
+    tcl_wordBreakBefore "ab cd" -1
+} -result -1
+test word-6.1 {tcl_wordBreakBefore} -body {
+    tcl_wordBreakBefore "ab cd" 0
+} -result -1
+test word-6.2 {tcl_wordBreakBefore} -body {
+    tcl_wordBreakBefore "ab cd" 1
+} -result -1
+test word-6.3 {tcl_wordBreakBefore} -body {
+    tcl_wordBreakBefore "ab cd" 2
+} -result 2
+test word-6.4 {tcl_wordBreakBefore} -body {
+    tcl_wordBreakBefore "ab cd" 3
+} -result 3
+test word-6.5 {tcl_wordBreakBefore} -body {
+    tcl_wordBreakBefore "ab cd" 4
+} -result 3
+test word-6.6 {tcl_wordBreakBefore} -body {
+    tcl_wordBreakBefore "ab cd" 5
+} -result 3
+test word-6.7 {tcl_wordBreakBefore} -body {
+    tcl_wordBreakBefore "ab cd" end
+} -result 3
+test word-6.8 {tcl_wordBreakBefore} -body {
+    tcl_wordBreakBefore "ab cd" {}
+} -result -1
+test word-6.9 {tcl_wordBreakBefore} -body {
+    tcl_startOfNextWord "ab cd" end-1
+} -result -1
+
+test word-7.0 {tcl_wordBreakAfter} -body {
+    tcl_wordBreakAfter "ab cd" -1
+} -result 2
+test word-7.1 {tcl_wordBreakAfter} -body {
+    tcl_wordBreakAfter "ab cd" 0
+} -result 2
+test word-7.2 {tcl_wordBreakAfter} -body {
+    tcl_wordBreakAfter "ab cd" 1
+} -result 2
+test word-7.3 {tcl_wordBreakAfter} -body {
+    tcl_wordBreakAfter "ab cd" 2
+} -result 3
+test word-7.4 {tcl_wordBreakAfter} -body {
+    tcl_wordBreakAfter "ab cd" 3
+} -result -1
+test word-7.5 {tcl_wordBreakAfter} -body {
+    tcl_wordBreakAfter "ab cd" 4
+} -result -1
+test word-7.6 {tcl_wordBreakAfter} -body {
+    tcl_wordBreakAfter "ab cd" 5
+} -result -1
+test word-7.7 {tcl_wordBreakAfter} -body {
+    tcl_wordBreakAfter "ab cd" end
+} -result -1
+test word-7.8 {tcl_wordBreakAfter} -body {
+    tcl_wordBreakAfter "ab cd" {}
+} -result 2
+test word-7.9 {tcl_wordBreakAfter} -body {
+    tcl_wordBreakAfter "ab cd" end-1
+} -result -1
+
+test word-8.2 {tcl_startOfPreviousWord} -body {
+    tcl_startOfPreviousWord a b c d
+} -returnCodes 1 -result {wrong # args: should be "tcl_startOfPreviousWord str start"}
+test word-8.3 {tcl_startOfNextWord} -body {
+    tcl_startOfNextWord a b c d
+} -returnCodes 1 -result {wrong # args: should be "tcl_startOfNextWord str start"}
+test word-8.4 {tcl_endOfWord} -body {
+    tcl_endOfWord a b c d
+} -returnCodes 1 -result {wrong # args: should be "tcl_endOfWord str start"}
+test word-8.5 {tcl_wordBreakBefore} -body {
+    tcl_wordBreakBefore a b c d
+} -returnCodes 1 -result {wrong # args: should be "tcl_wordBreakBefore str start"}
+test word-8.6 {tcl_wordBreakAfter} -body {
+    tcl_wordBreakAfter a b c d
+} -returnCodes 1 -result {wrong # args: should be "tcl_wordBreakAfter str start"}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End: