diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2024-01-26 13:46:43 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2024-01-26 13:46:43 (GMT) |
commit | fe3b8880257c766d46156bf0089ea8b17c563a0e (patch) | |
tree | 8636fef8969af11d4e2e97d45a78d602c80727fb | |
parent | f8d6a0caa7bae8039d97eee6e30486fb424c438c (diff) | |
parent | b098e6a2189e87427ee4498789b2c9b1979c5c4d (diff) | |
download | tcl-fe3b8880257c766d46156bf0089ea8b17c563a0e.zip tcl-fe3b8880257c766d46156bf0089ea8b17c563a0e.tar.gz tcl-fe3b8880257c766d46156bf0089ea8b17c563a0e.tar.bz2 |
Merge 8.7
-rw-r--r-- | library/word.tcl | 15 | ||||
-rw-r--r-- | tests/word.test | 192 |
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: |