text.test

linux系统下的音频通信

# This file is a Tcl script to test the code in the file tkText.c.
# This file is organized in the standard fashion for Tcl tests.
#
# 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.
#
# SCCS: @(#) text.test 1.46 97/10/13 15:18:31

if {[string compare test [info procs test]] == 1} then \
  {source defs}

eval destroy [winfo child .]

# Create entries in the option database to be sure that geometry options
# like border width have predictable values.

option add *Text.borderWidth 2
option add *Text.highlightThickness 2
option add *Text.font {Courier -12}

text .t -width 20 -height 10
pack append . .t {top expand fill}
update
.t debug on
wm geometry . {}

# The statements below reset the main window;  it's needed if the window
# manager is mwm to make mwm forget about a previous minimum size setting.

wm withdraw .
wm minsize . 1 1
wm positionfrom . user
wm deiconify .

entry .t.e
.t.e insert end abcdefg
.t.e select from 0

.t insert 1.0 "Line 1
abcdefghijklm
12345
Line 4
bOy GIrl .#@? x_yz
!@#$%
Line 7"

catch {destroy .t2}
text .t2
set i 0
foreach test {
    {-background #ff00ff #ff00ff <gorp>}
    {-bd 4 4 foo}
    {-bg blue blue #xx}
    {-borderwidth 7 7 ++}
    {-cursor watch watch lousy}
    {-exportselection no 0 maybe}
    {-fg red red stupid}
    {-font fixed fixed {}}
    {-foreground #012 #012 bogus}
    {-height 5 5 bad}
    {-highlightbackground #123 #123 bogus}
    {-highlightcolor #234 #234 bogus}
    {-highlightthickness -2 0 bad}
    {-insertbackground green green <bogus>}
    {-insertborderwidth 45 45 bogus}
    {-insertofftime 100 100 2.4}
    {-insertontime 47 47 e1}
    {-insertwidth 2.3 2 47d}
    {-padx 3.4 3 2.4.}
    {-pady 82 82 bogus}
    {-relief raised raised bumpy}
    {-selectbackground #ffff01234567 #ffff01234567 bogus}
    {-selectborderwidth 21 21 3x}
    {-selectforeground yellow yellow #12345}
    {-spacing1 20 20 1.3x}
    {-spacing1 -5 0 bogus}
    {-spacing2 5 5 bogus}
    {-spacing2 -1 0 bogus}
    {-spacing3 20 20 bogus}
    {-spacing3 -10 0 bogus}
    {-state disabled disabled foo}
    {-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs}
    {-width 73 73 2.4}
    {-wrap word word bad_wrap}
} {
    test text-1.[incr i] {text options} {
	set result {}
	lappend result [catch {.t2 configure [lindex $test 0] [lindex $test 3]}]
	.t2 configure [lindex $test 0] [lindex $test 1]
	lappend result [.t2 cget [lindex $test 0]]
    } [list 1 [lindex $test 2]]
}
test text-1.[incr i] {text options} {
    .t2 configure -takefocus "any old thing"
    .t2 cget -takefocus
} {any old thing}
test text-1.[incr i] {text options} {
    .t2 configure -xscrollcommand "x scroll command"
    .t2 configure -xscrollcommand
} {-xscrollcommand xScrollCommand ScrollCommand {} {x scroll command}}
test text-1.[incr i] {text options} {
    .t2 configure -yscrollcommand "test command"
    .t2 configure -yscrollcommand
} {-yscrollcommand yScrollCommand ScrollCommand {} {test command}}
test text-1.[incr i] {text options} {
    set result {}
    foreach i [.t2 configure] {
	lappend result [lindex $i 4]
    }
    set result
} {blue {} {} 7 watch 0 {} fixed #012 5 #123 #234 0 green 45 100 47 2 3 82 raised #ffff01234567 21 yellow 0 0 0 0 disabled {1i 2i 3i 4i} {any old thing} 73 word {x scroll command} {test command}}

test text-2.1 {Tk_TextCmd procedure} {
    list [catch {text} msg] $msg
} {1 {wrong # args: should be "text pathName ?options?"}}
test text-2.2 {Tk_TextCmd procedure} {
    list [catch {text foobar} msg] $msg
} {1 {bad window path name "foobar"}}
test text-2.3 {Tk_TextCmd procedure} {
    catch {destroy .t2}
    list [catch {text .t2 -gorp nofun} msg] $msg [winfo exists .t2]
} {1 {unknown option "-gorp"} 0}
test text-2.4 {Tk_TextCmd procedure} {
    catch {destroy .t2}
    list [catch {text .t2 -bd 2 -fg red} msg] $msg \
	[lindex [.t2 config -bd] 4] [lindex [.t2 config -fg] 4]
} {0 .t2 2 red}
if {$tcl_platform(platform) == "macintosh"} {
    set relief solid
} elseif {$tcl_platform(platform) == "windows"} {
    set relief flat
} else {
    set relief raised
}
test text-2.5 {Tk_TextCmd procedure} {
    catch {destroy .t2}
    text .t2
    .t2 tag cget sel -relief 
} $relief
test text-2.6 {Tk_TextCmd procedure} {
    catch {destroy .t2}
    list [text .t2] [winfo class .t2]
} {.t2 Text}

test text-3.1 {TextWidgetCmd procedure, basics} {
    list [catch {.t} msg] $msg
} {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}}

test text-4.1 {TextWidgetCmd procedure, "bbox" option} {
    list [catch {.t bbox} msg] $msg
} {1 {wrong # args: should be ".t bbox index"}}
test text-4.2 {TextWidgetCmd procedure, "bbox" option} {
    list [catch {.t bbox a b} msg] $msg
} {1 {wrong # args: should be ".t bbox index"}}
test text-4.3 {TextWidgetCmd procedure, "bbox" option} {
    list [catch {.t bbox bad_mark} msg] $msg
} {1 {bad text index "bad_mark"}}

test text-5.1 {TextWidgetCmd procedure, "cget" option} {
    list [catch {.t cget} msg] $msg
} {1 {wrong # args: should be ".t cget option"}}
test text-5.2 {TextWidgetCmd procedure, "cget" option} {
    list [catch {.t cget a b} msg] $msg
} {1 {wrong # args: should be ".t cget option"}}
test text-5.3 {TextWidgetCmd procedure, "cget" option} {
    list [catch {.t cget -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test text-5.4 {TextWidgetCmd procedure, "cget" option} {
    .t configure -bd 17
    .t cget -bd
} {17}
.t configure -bd [lindex [.t configure -bd] 3]

test text-6.1 {TextWidgetCmd procedure, "compare" option} {
    list [catch {.t compare a b} msg] $msg
} {1 {wrong # args: should be ".t compare index1 op index2"}}
test text-6.2 {TextWidgetCmd procedure, "compare" option} {
    list [catch {.t compare a b c d} msg] $msg
} {1 {wrong # args: should be ".t compare index1 op index2"}}
test text-6.3 {TextWidgetCmd procedure, "compare" option} {
    list [catch {.t compare @x == 1.0} msg] $msg
} {1 {bad text index "@x"}}
test text-6.4 {TextWidgetCmd procedure, "compare" option} {
    list [catch {.t compare 1.0 < @y} msg] $msg
} {1 {bad text index "@y"}}
test text-6.5 {TextWidgetCmd procedure, "compare" option} {
    list [.t compare 1.1 < 1.0] [.t compare 1.1 < 1.1] [.t compare 1.1 < 1.2]
} {0 0 1}
test text-6.6 {TextWidgetCmd procedure, "compare" option} {
    list [.t compare 1.1 <= 1.0] [.t compare 1.1 <= 1.1] [.t compare 1.1 <= 1.2]
} {0 1 1}
test text-6.7 {TextWidgetCmd procedure, "compare" option} {
    list [.t compare 1.1 == 1.0] [.t compare 1.1 == 1.1] [.t compare 1.1 == 1.2]
} {0 1 0}
test text-6.8 {TextWidgetCmd procedure, "compare" option} {
    list [.t compare 1.1 >= 1.0] [.t compare 1.1 >= 1.1] [.t compare 1.1 >= 1.2]
} {1 1 0}
test text-6.9 {TextWidgetCmd procedure, "compare" option} {
    list [.t compare 1.1 > 1.0] [.t compare 1.1 > 1.1] [.t compare 1.1 > 1.2]
} {1 0 0}
test text-6.10 {TextWidgetCmd procedure, "compare" option} {
    list [.t com 1.1 != 1.0] [.t compare 1.1 != 1.1] [.t compare 1.1 != 1.2]
} {1 0 1}
test text-6.11 {TextWidgetCmd procedure, "compare" option} {
    list [catch {.t compare 1.0 <x 1.2} msg] $msg
} {1 {bad comparison operator "<x": must be <, <=, ==, >=, >, or !=}}
test text-6.12 {TextWidgetCmd procedure, "compare" option} {
    list [catch {.t compare 1.0 >> 1.2} msg] $msg
} {1 {bad comparison operator ">>": must be <, <=, ==, >=, >, or !=}}
test text-6.13 {TextWidgetCmd procedure, "compare" option} {
    list [catch {.t compare 1.0 z 1.2} 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}}

# "configure" option is already covered above

test text-7.1 {TextWidgetCmd procedure, "debug" option} {
    list [catch {.t debug 0 1} msg] $msg
} {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}}
test text-7.3 {TextWidgetCmd procedure, "debug" option} {
    .t debug true
    .t deb
} 1
test text-7.4 {TextWidgetCmd procedure, "debug" option} {
    .t debug false
    .t debug
} 0
.t debug

test text-8.1 {TextWidgetCmd procedure, "delete" option} {
    list [catch {.t delete} msg] $msg
} {1 {wrong # args: should be ".t delete index1 ?index2?"}}
test text-8.2 {TextWidgetCmd procedure, "delete" option} {
    list [catch {.t delete a b c} msg] $msg
} {1 {wrong # args: should be ".t delete index1 ?index2?"}}
test text-8.3 {TextWidgetCmd procedure, "delete" option} {
    list [catch {.t delete @x 2.2} msg] $msg
} {1 {bad text index "@x"}}
test text-8.4 {TextWidgetCmd procedure, "delete" option} {
    list [catch {.t delete 2.3 @y} msg] $msg
} {1 {bad text index "@y"}}
test text-8.5 {TextWidgetCmd procedure, "delete" option} {
    .t con -state disabled
    .t delete 2.3
    .t g 2.0 2.end
} abcdefghijklm
.t con -state normal
test text-8.6 {TextWidgetCmd procedure, "delete" option} {
    .t delete 2.3
    .t get 2.0 2.end
} abcefghijklm
test text-8.7 {TextWidgetCmd procedure, "delete" option} {
    .t delete 2.1 2.3
    .t get 2.0 2.end
} aefghijklm

test text-9.1 {TextWidgetCmd procedure, "get" option} {
    list [catch {.t get} msg] $msg
} {1 {wrong # args: should be ".t get index1 ?index2?"}}
test text-9.2 {TextWidgetCmd procedure, "get" option} {
    list [catch {.t get a b c} msg] $msg
} {1 {wrong # args: should be ".t get index1 ?index2?"}}
test text-9.3 {TextWidgetCmd procedure, "get" option} {
    list [catch {.t get @q 3.1} msg] $msg
} {1 {bad text index "@q"}}
test text-9.4 {TextWidgetCmd procedure, "get" option} {
    list [catch {.t get 3.1 @r} msg] $msg
} {1 {bad text index "@r"}}
test text-9.5 {TextWidgetCmd procedure, "get" option} {
    .t get 5.7 5.3
} {}
test text-9.6 {TextWidgetCmd procedure, "get" option} {
    .t get 5.3 5.5
} { G}
test text-9.7 {TextWidgetCmd procedure, "get" option} {
    .t get 5.3 end
} { GIrl .#@? x_yz
!@#$%
Line 7
}
.t mark set a 5.3
.t mark set b 5.3
.t mark set c 5.5
test text-9.8 {TextWidgetCmd procedure, "get" option} {
    .t get 5.2 5.7
} {y GIr}
test text-9.9 {TextWidgetCmd procedure, "get" option} {
    .t get 5.2
} {y}
test text-9.10 {TextWidgetCmd procedure, "get" option} {
    .t get 5.2 5.4
} {y }

test text-10.1 {TextWidgetCmd procedure, "index" option} {
    list [catch {.t index} msg] $msg
} {1 {wrong # args: should be ".t index index"}}
test text-10.2 {TextWidgetCmd procedure, "index" option} {
    list [catch {.t ind a b} msg] $msg
} {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}}
test text-10.4 {TextWidgetCmd procedure, "index" option} {
    list [catch {.t index @xyz} msg] $msg
} {1 {bad text index "@xyz"}}
test text-10.5 {TextWidgetCmd procedure, "index" option} {
    .t index 1.2
} 1.2

test text-11.1 {TextWidgetCmd procedure, "insert" option} {
    list [catch {.t insert 1.2} msg] $msg
} {1 {wrong # args: should be ".t insert index chars ?tagList chars tagList ...?"}}
test text-11.2 {TextWidgetCmd procedure, "insert" option} {
    .t config -state disabled
    .t insert 1.2 xyzzy
    .t get 1.0 1.end
} {Line 1}
.t config -state normal
test text-11.3 {TextWidgetCmd procedure, "insert" option} {
    .t insert 1.2 xyzzy
    .t get 1.0 1.end
} {Lixyzzyne 1}
test text-11.4 {TextWidgetCmd procedure, "insert" option} {
    .t delete 1.0 end
    .t insert 1.0 "Sample text" x
    .t tag ranges x
} {1.0 1.11}
test text-11.5 {TextWidgetCmd procedure, "insert" option} {
    .t delete 1.0 end
    .t insert 1.0 "Sample text" x
    .t insert 1.2 "XYZ" y
    list [.t tag ranges x] [.t tag ranges y]
} {{1.0 1.2 1.5 1.14} {1.2 1.5}}
test text-11.6 {TextWidgetCmd procedure, "insert" option} {
    .t delete 1.0 end
    .t insert 1.0 "Sample text" {x y z}
    list [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
} {{1.0 1.11} {1.0 1.11} {1.0 1.11}}
test text-11.7 {TextWidgetCmd procedure, "insert" option} {
    .t delete 1.0 end
    .t insert 1.0 "Sample text" {x y z}
    .t insert 1.3 "A" {a b z}
    list [.t tag ranges a] [.t tag ranges b] [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
} {{1.3 1.4} {1.3 1.4} {1.0 1.3 1.4 1.12} {1.0 1.3 1.4 1.12} {1.0 1.12}}
test text-11.8 {TextWidgetCmd procedure, "insert" option} {
    .t delete 1.0 end
    list [catch {.t insert 1.0 "Sample text" "a \{b"} msg] $msg
} {1 {unmatched open brace in list}}
test text-11.9 {TextWidgetCmd procedure, "insert" option} {
    .t delete 1.0 end
    .t insert 1.0 "First" bold " " {} second "x y z" " third"
    list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges x] \
	    [.t tag ranges y] [.t tag ranges z]
} {{First second third} {1.0 1.5} {1.6 1.12} {1.6 1.12} {1.6 1.12}}
test text-11.10 {TextWidgetCmd procedure, "insert" option} {
    .t delete 1.0 end
    .t insert 1.0 "First" bold " second" silly
    list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly]
} {{First second} {1.0 1.5} {1.5 1.12}}

# Mark, scan, search, see, tag, window, xview, and yview actions are tested elsewhere.

test text-12.1 {ConfigureText procedure} {
    list [catch {.t2 configure -state foobar} msg] $msg
} {1 {bad state value "foobar": must be normal or disabled}}
test text-12.2 {ConfigureText procedure} {
    .t2 configure -spacing1 -2 -spacing2 1 -spacing3 1
    list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
} {0 1 1}
test text-12.3 {ConfigureText procedure} {
    .t2 configure -spacing1 1 -spacing2 -1 -spacing3 1
    list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
} {1 0 1}
test text-12.4 {ConfigureText procedure} {
    .t2 configure -spacing1 1 -spacing2 1 -spacing3 -3
    list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
} {1 1 0}
test text-12.5 {ConfigureText procedure} {
    set x [list [catch {.t2 configure -tabs {30 foo}} msg] $msg $errorInfo]
    .t2 configure -tabs {10 20 30}
    set x
} {1 {bad tab alignment "foo": must be left, right, center, or numeric} {bad tab alignment "foo": must be left, right, center, or numeric
    (while processing -tabs option)
    invoked from within
".t2 configure -tabs {30 foo}"}}
test text-12.6 {ConfigureText procedure} {
    .t2 configure -tabs {10 20 30}
    .t2 configure -tabs {}
    .t2 cget -tabs
} {}
test text-12.7 {ConfigureText procedure} {
    list [catch {.t2 configure -wrap bogus} msg] $msg
} {1 {bad wrap mode "bogus": must be char, none, or word}}
test text-12.8 {ConfigureText procedure} {
    .t2 configure -selectborderwidth 17 -selectforeground #332211 \
	    -selectbackground #abc
    list [lindex [.t2 tag config sel -borderwidth] 4] \
	[lindex [.t2 tag config sel -foreground] 4] \
	[lindex [.t2 tag config sel -background] 4]
} {17 #332211 #abc}
test text-12.9 {ConfigureText procedure} {
    .t2 configure -selectborderwidth {}
    .t2 tag cget sel -borderwidth
} {}
test text-12.10 {ConfigureText procedure} {
    list [catch {.t2 configure -selectborderwidth foo} msg] $msg
} {1 {bad screen distance "foo"}}
test text-12.11 {ConfigureText procedure} {
    catch {destroy .t2}
    .t.e select to 2