diff options
Diffstat (limited to 'tk/tests/text.test')
| -rw-r--r-- | tk/tests/text.test | 156 |
1 files changed, 141 insertions, 15 deletions
diff --git a/tk/tests/text.test b/tk/tests/text.test index 533fd4e9ad3..e002c7e43b5 100644 --- a/tk/tests/text.test +++ b/tk/tests/text.test @@ -3,14 +3,14 @@ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # # RCS: @(#) $Id$ -if {[string compare test [info procs test]] == 1} then \ - {source defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} eval destroy [winfo child .] @@ -81,10 +81,10 @@ foreach test { {-spacing2 -1 0 bogus} {-spacing3 20 20 bogus} {-spacing3 -10 0 bogus} - {-state disabled disabled foo} + {-state d disabled foo} {-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs} {-width 73 73 2.4} - {-wrap word word bad_wrap} + {-wrap w word bad_wrap} } { test text-1.[incr i] {text options} { set result {} @@ -150,7 +150,7 @@ test text-3.1 {TextWidgetCmd procedure, basics} { } {1 {wrong # args: should be ".t option ?arg arg ...?"}} test text-3.2 {TextWidgetCmd procedure} { list [catch {.t gorp 1.0 z 1.2} msg] $msg -} {1 {bad option "gorp": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} +} {1 {bad option "gorp": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} test text-4.1 {TextWidgetCmd procedure, "bbox" option} { list [catch {.t bbox} msg] $msg @@ -218,7 +218,7 @@ test text-6.13 {TextWidgetCmd procedure, "compare" option} { } {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}} test text-6.14 {TextWidgetCmd procedure, "compare" option} { list [catch {.t co 1.0 z 1.2} msg] $msg -} {1 {bad option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} +} {1 {bad option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} # "configure" option is already covered above @@ -227,7 +227,7 @@ test text-7.1 {TextWidgetCmd procedure, "debug" option} { } {1 {wrong # args: should be ".t debug boolean"}} test text-7.2 {TextWidgetCmd procedure, "debug" option} { list [catch {.t de 0 1} msg] $msg -} {1 {bad option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} +} {1 {bad option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} test text-7.3 {TextWidgetCmd procedure, "debug" option} { .t debug true .t deb @@ -310,7 +310,7 @@ test text-10.2 {TextWidgetCmd procedure, "index" option} { } {1 {wrong # args: should be ".t index index"}} test text-10.3 {TextWidgetCmd procedure, "index" option} { list [catch {.t in a b} msg] $msg -} {1 {bad option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} +} {1 {bad option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} test text-10.4 {TextWidgetCmd procedure, "index" option} { list [catch {.t index @xyz} msg] $msg } {1 {bad text index "@xyz"}} @@ -854,7 +854,7 @@ test text-19.3 {TkTextLostSelection procedure} { .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" test text-20.1 {TextSearchCmd procedure, argument parsing} { list [catch {.t search -} msg] $msg -} {1 {bad switch "-": must be -forward, -backward, -exact, -regexp, -nocase, -count, or --}} +} {1 {bad switch "-": must be --, -backward, -count, -elide, -exact, -forward, -nocase, or -regexp}} test text-20.2 {TextSearchCmd procedure, -backwards option} { .t search -backwards xyz 1.4 } {1.1} @@ -885,10 +885,10 @@ test text-20.10 {TextSearchCmd procedure, -- option} { } {2.4} test text-20.11 {TextSearchCmd procedure, argument parsing} { list [catch {.t search abc} msg] $msg -} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?}} +} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"}} test text-20.12 {TextSearchCmd procedure, argument parsing} { list [catch {.t search abc d e f} msg] $msg -} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?}} +} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"}} test text-20.13 {TextSearchCmd procedure, check index} { list [catch {.t search abc gorp} msg] $msg } {1 {bad text index "gorp"}} @@ -906,7 +906,7 @@ test text-20.17 {TextSearchCmd procedure, pattern case conversion} { } {2.13 {}} test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} { list [catch {.t search -regexp a( 1.0} msg] $msg -} {1 {couldn't compile regular expression pattern: unmatched ()}} +} {1 {couldn't compile regular expression pattern: parentheses () not balanced}} test text-20.19 {TextSearchCmd procedure, skip dummy last line} { .t search -backwards BaR end 1.0 } {2.23} @@ -961,6 +961,13 @@ test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} { test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} { .t search {} end } {1.0} +test text-20.36 {TextSearchCmd procedure, regexp finds empty lines} { + # Test for fix of bug #1643 + .t insert end "\n" + tkTextSetCursor .t 4.0 + .t search -forward -regexp {^$} insert end +} {4.0} + catch {destroy .t2} toplevel .t2 wm geometry .t2 +0+0 @@ -1082,7 +1089,81 @@ test text-20.62 {TextSearchCmd, freeing copy of pattern} { set p $p$p$p$p$p .t search -nocase $p 1.0 } {} +test text-20.63 {TextSearchCmd, unicode} { + .t delete 1.0 end + .t insert end "foo\u30c9\u30cabar" + .t search \u30c9\u30ca 1.0 +} 1.3 +test text-20.64 {TextSearchCmd, unicode} { + .t delete 1.0 end + .t insert end "foo\u30c9\u30cabar" + list [.t search -count n \u30c9\u30ca 1.0] $n +} {1.3 2} +test text-20.65 {TextSearchCmd, unicode with non-text segments} { + .t delete 1.0 end + button .b1 -text baz + .t insert end "foo\u30c9" + .t window create end -window .b1 + .t insert end "\u30cabar" + set result [list [.t search -count n \u30c9\u30ca 1.0] $n] + destroy .b1 + set result +} {1.3 3} + +test text-20.66 {TextSearchCmd, hidden text does not affect match index} { + eval destroy [winfo child .] + pack [text .t2] + .t2 insert end "12345H7890" + .t2 search 7 1.0 +} 1.6 +test text-20.67 {TextSearchCmd, hidden text does not affect match index} { + eval destroy [winfo child .] + pack [text .t2] + .t2 insert end "12345H7890" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.5 + .t2 search 7 1.0 +} 1.6 +test text-20.68 {TextSearchCmd, hidden text does not affect match index} { + eval destroy [winfo child .] + pack [text .t2] + .t2 insert end "foobar\nbarbaz\nbazboo" + .t2 search boo 1.0 +} 3.3 +test text-20.69 {TextSearchCmd, hidden text does not affect match index} { + eval destroy [winfo child .] + pack [text .t2] + .t2 insert end "foobar\nbarbaz\nbazboo" + .t2 tag configure hidden -elide true + .t2 tag add hidden 2.0 3.0 + .t2 search boo 1.0 +} 3.3 +test text-20.70 {TextSearchCmd, -regexp -nocase searches} { + catch {destroy .t} + pack [text .t] + .t insert end "word1 word2" + set res [.t search -nocase -regexp {\mword.} 1.0 end] + destroy .t + set res +} 1.0 +test text-20.71 {TextSearchCmd, -regexp -nocase searches} { + catch {destroy .t} + pack [text .t] + .t insert end "word1 word2" + set res [.t search -nocase -regexp {word.\M} 1.0 end] + destroy .t + set res +} 1.0 +test text-20.72 {TextSearchCmd, -regexp -nocase searches} { + catch {destroy .t} + pack [text .t] + .t insert end "word1 word2" + set res [.t search -nocase -regexp {word.\W} 1.0 end] + destroy .t + set res +} 1.0 + eval destroy [winfo child .] text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 pack .t2 @@ -1246,6 +1327,20 @@ test text-22.24 {TextDumpCmd procedure, command script} { set x } {mark 1.0 current mark 1.0 insert mark 2.4 m} catch {unset x} +test text-22.25 {TextDumpCmd procedure, unicode characters} { + catch {destroy .t} + text .t + .t delete 1.0 end + .t insert 1.0 \xb1\xb1\xb1 + .t dump -all 1.0 2.0 +} "text \xb1\xb1\xb1 1.0 mark insert 1.3 mark current 1.3 text {\n} 1.3" +test text-22.26 {TextDumpCmd procedure, unicode characters} { + catch {destroy .t} + text .t + .t delete 1.0 end + .t insert 1.0 abc\xb1\xb1\xb1 + .t dump -all 1.0 2.0 +} "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6" set l [interp hidden] eval destroy [winfo children .] @@ -1258,5 +1353,36 @@ test text-23.1 {text widget vs hidden commands} { list [winfo children .] [interp hidden] } [list {} $l] +test text-24.1 {bug fix - 1642} { + catch {destroy .t} + text .t + pack .t + .t insert end "line 1\n" + .t insert end "line 2\n" + .t insert end "line 3\n" + .t insert end "line 4\n" + .t insert end "line 5\n" + tkTextSetCursor .t 3.0 + .t search -backward -regexp "\$" insert 1.0 +} {2.6} + eval destroy [winfo child .] option clear + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + + |