summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2024-01-26 13:46:43 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2024-01-26 13:46:43 (GMT)
commitfe3b8880257c766d46156bf0089ea8b17c563a0e (patch)
tree8636fef8969af11d4e2e97d45a78d602c80727fb
parentf8d6a0caa7bae8039d97eee6e30486fb424c438c (diff)
parentb098e6a2189e87427ee4498789b2c9b1979c5c4d (diff)
downloadtcl-fe3b8880257c766d46156bf0089ea8b17c563a0e.zip
tcl-fe3b8880257c766d46156bf0089ea8b17c563a0e.tar.gz
tcl-fe3b8880257c766d46156bf0089ea8b17c563a0e.tar.bz2
Merge 8.7
-rw-r--r--library/word.tcl15
-rw-r--r--tests/word.test192
2 files changed, 205 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..f616064
--- /dev/null
+++ b/tests/word.test
@@ -0,0 +1,192 @@
+# 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 (c) 2024 Jan Nijtmans
+# 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, bug [16e25e1402]} -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: