#
# 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 .]
{-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 {}
} {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
} {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
} {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
} {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"}}
.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}
} {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"}}
} {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}
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
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
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 .]
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
OSDN Git Service
