entry.test

linux系统下的音频通信

# This file is a Tcl script to test entry widgets in Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 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: @(#) entry.test 1.49 97/11/07 09:34:31

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\""
    puts "image, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    return
}

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

proc scroll args {
    global scrollInfo
    set scrollInfo $args
}

# Create additional widget that's used to hold the selection at times.

entry .sel
.sel insert end "This is some sample text"

# Font names

set big -adobe-helvetica-medium-r-normal--24-240-75-75-p-*-iso8859-1
set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1

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

option add *Entry.borderWidth 2
option add *Entry.highlightThickness 2
option add *Entry.font {Helvetica -12}

entry .e -bd 2 -relief sunken
pack .e
update
set i 1
foreach test {
    {-background #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-bd 4 4 badValue {bad screen distance "badValue"}}
    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
    {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}}
    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
    {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
	-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {}
	{font "" doesn't exist}}
    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
    {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}}
    {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
    {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
    {-highlightthickness -2 0 {} {}}
    {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}}
    {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}}
    {-insertofftime 100 100 3.2 {expected integer but got "3.2"}}
    {-insertontime 100 100 3.2 {expected integer but got "3.2"}}
    {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
    {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
    {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
    {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
    {-show * * {} {}}
    {-state normal normal bogus {bad state value "bogus": must be normal or disabled}}
    {-takefocus "any string" "any string" {} {}}
    {-textvariable i i {} {}}
    {-width 402 402 3p {expected integer but got "3p"}}
    {-xscrollcommand {Some command} {Some command} {} {}}
} {
    set name [lindex $test 0]
    test entry-1.1 {configuration options} {
	.e configure $name [lindex $test 1]
	list [lindex [.e configure $name] 4] [.e cget $name]
    } [list [lindex $test 2] [lindex $test 2]]
    incr i
    if {[lindex $test 3] != ""} {
	test entry-1.2 {configuration options} {
	    list [catch {.e configure $name [lindex $test 3]} msg] $msg
	} [list 1 [lindex $test 4]]
    }
    .e configure $name [lindex [.e configure $name] 3]
    incr i
}

test entry-2.1 {Tk_EntryCmd procedure} {
    list [catch {entry} msg] $msg
} {1 {wrong # args: should be "entry pathName ?options?"}}
test entry-2.2 {Tk_EntryCmd procedure} {
    list [catch {entry gorp} msg] $msg
} {1 {bad window path name "gorp"}}
test entry-2.3 {Tk_EntryCmd procedure} {
    catch {destroy .e}
    entry .e
    list [winfo exists .e] [winfo class .e] [info commands .e]
} {1 Entry .e}
test entry-2.4 {Tk_EntryCmd procedure} {
    catch {destroy .e}
    list [catch {entry .e -gorp foo} msg] $msg [winfo exists .e] \
	    [info commands .e]
} {1 {unknown option "-gorp"} 0 {}}
test entry-2.5 {Tk_EntryCmd procedure} {
    catch {destroy .e}
    entry .e
} {.e}

catch {destroy .e}
entry .e -font $fixed
pack .e
update

set cx [font measure $fixed a]
set cy [font metrics $fixed -linespace]

test entry-3.1 {EntryWidgetCmd procedure} {
    list [catch {.e} msg] $msg
} {1 {wrong # args: should be ".e option ?arg arg ...?"}}
test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} {
    list [catch {.e bbox} msg] $msg
} {1 {wrong # args: should be ".e bbox index"}}
test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} {
    list [catch {.e bbox a b} msg] $msg
} {1 {wrong # args: should be ".e bbox index"}}
test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} {
    list [catch {.e bbox bogus} msg] $msg
} {1 {bad entry index "bogus"}}
test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} {
    .e delete 0 end
    .e bbox 0
} [list 5 5 0 $cy]
test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} {fonts} {
    .e delete 0 end
    .e insert 0 "abcdefghijklmnop"
    list [.e bbox 0] [.e bbox 1] [.e bbox end]
} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+15*$cx] 5 $cx $cy"]
test entry-3.7 {EntryWidgetCmd procedure, "cget" widget command} {
    list [catch {.e cget} msg] $msg
} {1 {wrong # args: should be ".e cget option"}}
test entry-3.8 {EntryWidgetCmd procedure, "cget" widget command} {
    list [catch {.e cget a b} msg] $msg
} {1 {wrong # args: should be ".e cget option"}}
test entry-3.9 {EntryWidgetCmd procedure, "cget" widget command} {
    list [catch {.e cget -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test entry-3.10 {EntryWidgetCmd procedure, "cget" widget command} {
    .e configure -bd 4
    .e cget -bd
} {4}
test entry-3.11 {EntryWidgetCmd procedure, "configure" widget command} {
    llength [.e configure]
} {28}
test entry-3.12 {EntryWidgetCmd procedure, "configure" widget command} {
    list [catch {.e configure -foo} msg] $msg
} {1 {unknown option "-foo"}}
test entry-3.13 {EntryWidgetCmd procedure, "configure" widget command} {
    .e configure -bd 4
    .e configure -bg #ffffff
    lindex [.e configure -bd] 4
} {4}
test entry-3.14 {EntryWidgetCmd procedure, "delete" widget command} {
    list [catch {.e delete} msg] $msg
} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
test entry-3.15 {EntryWidgetCmd procedure, "delete" widget command} {
    list [catch {.e delete a b c} msg] $msg
} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
test entry-3.16 {EntryWidgetCmd procedure, "delete" widget command} {
    list [catch {.e delete foo} msg] $msg
} {1 {bad entry index "foo"}}
test entry-3.17 {EntryWidgetCmd procedure, "delete" widget command} {
    list [catch {.e delete 0 bar} msg] $msg
} {1 {bad entry index "bar"}}
test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e delete 2 4
    .e get
} {014567890}
test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e delete 6
    .e get
} {0123457890}
test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e delete 6 5
    .e get
} {01234567890}
test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e configure -state disabled
    .e delete 2 8
    .e configure -state normal
    .e get
} {01234567890}
test entry-3.22 {EntryWidgetCmd procedure, "get" widget command} {
    list [catch {.e get foo} msg] $msg
} {1 {wrong # args: should be ".e get"}}
test entry-3.23 {EntryWidgetCmd procedure, "icursor" widget command} {
    list [catch {.e icursor} msg] $msg
} {1 {wrong # args: should be ".e icursor pos"}}
test entry-3.24 {EntryWidgetCmd procedure, "icursor" widget command} {
    list [catch {.e icursor foo} msg] $msg
} {1 {bad entry index "foo"}}
test entry-3.25 {EntryWidgetCmd procedure, "icursor" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e icursor 4
    .e index insert
} {4}
test entry-3.26 {EntryWidgetCmd procedure, "index" widget command} {
    list [catch {.e in} msg] $msg
} {1 {bad option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}}
test entry-3.27 {EntryWidgetCmd procedure, "index" widget command} {
    list [catch {.e index} msg] $msg
} {1 {wrong # args: should be ".e index string"}}
test entry-3.28 {EntryWidgetCmd procedure, "index" widget command} {
    list [catch {.e index foo} msg] $msg
} {1 {bad entry index "foo"}}
test entry-3.29 {EntryWidgetCmd procedure, "index" widget command} {
    list [catch {.e index 0} msg] $msg
} {0 0}
test entry-3.30 {EntryWidgetCmd procedure, "insert" widget command} {
    list [catch {.e insert a} msg] $msg
} {1 {wrong # args: should be ".e insert index text"}}
test entry-3.31 {EntryWidgetCmd procedure, "insert" widget command} {
    list [catch {.e insert a b c} msg] $msg
} {1 {wrong # args: should be ".e insert index text"}}
test entry-3.32 {EntryWidgetCmd procedure, "insert" widget command} {
    list [catch {.e insert foo Text} msg] $msg
} {1 {bad entry index "foo"}}
test entry-3.33 {EntryWidgetCmd procedure, "insert" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e insert 3 xxx
    .e get
} {012xxx34567890}
test entry-3.34 {EntryWidgetCmd procedure, "insert" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e configure -state disabled
    .e insert 3 xxx
    .e configure -state normal
    .e get
} {01234567890}
test entry-3.35 {EntryWidgetCmd procedure, "insert" widget command} {
    list [catch {.e insert a b c} msg] $msg
} {1 {wrong # args: should be ".e insert index text"}}
test entry-3.36 {EntryWidgetCmd procedure, "scan" widget command} {
    list [catch {.e scan a} msg] $msg
} {1 {wrong # args: should be ".e scan mark|dragto x"}}
test entry-3.37 {EntryWidgetCmd procedure, "scan" widget command} {
    list [catch {.e scan a b c} msg] $msg
} {1 {wrong # args: should be ".e scan mark|dragto x"}}
test entry-3.38 {EntryWidgetCmd procedure, "scan" widget command} {
    list [catch {.e scan foobar 20} msg] $msg
} {1 {bad scan option "foobar": must be mark or dragto}}
test entry-3.39 {EntryWidgetCmd procedure, "scan" widget command} {
    list [catch {.e scan mark 20.1} msg] $msg
} {1 {expected integer but got "20.1"}}
# This test is non-portable because character sizes vary.

test entry-3.40 {EntryWidgetCmd procedure, "scan" widget command} {fonts} {
    .e delete 0 end
    update
    .e insert end "This is quite a long string, in fact a "
    .e insert end "very very long string"
    .e scan mark 30
    .e scan dragto 28
    .e index @0
} {2}
test entry-3.41 {EntryWidgetCmd procedure, "select" widget command} {
    list [catch {.e select} msg] $msg
} {1 {wrong # args: should be ".e select option ?index?"}}
test entry-3.42 {EntryWidgetCmd procedure, "select" widget command} {
    list [catch {.e select foo} msg] $msg
} {1 {bad selection option "foo": must be adjust, clear, from, present, range, or to}}
test entry-3.43 {EntryWidgetCmd procedure, "select clear" widget command} {
    list [catch {.e select clear gorp} msg] $msg
} {1 {wrong # args: should be ".e selection clear"}}
test entry-3.44 {EntryWidgetCmd procedure, "select clear" widget command} {
    .e delete 0 end
    .e insert end "0123456789"
    .e select from 1
    .e select to 4
    update
    .e select clear
    list [catch {selection get} msg] $msg [selection own]
} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e}
test entry-3.45 {EntryWidgetCmd procedure, "selection present" widget command} {
    list [catch {.e selection present foo} msg] $msg
} {1 {wrong # args: should be ".e selection present"}}
test entry-3.46 {EntryWidgetCmd procedure, "selection present" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 3
    .e select to 6
    .e selection present
} {1}
test entry-3.47 {EntryWidgetCmd procedure, "selection present" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 3
    .e select to 6
    .e configure -exportselection false
    .e selection present
} {1}
.e configure -exportselection true
test entry-3.48 {EntryWidgetCmd procedure, "selection present" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 3
    .e select to 6
    .e delete 0 end
    .e selection present
} {0}
test entry-3.49 {EntryWidgetCmd procedure, "selection adjust" widget command} {
    list [catch {.e select adjust x} msg] $msg
} {1 {bad entry index "x"}}
test entry-3.50 {EntryWidgetCmd procedure, "selection adjust" widget command} {
    list [catch {.e select adjust 2 3} msg] $msg
} {1 {wrong # args: should be ".e selection adjust index"}}
test entry-3.51 {EntryWidgetCmd procedure, "selection adjust" widget command} {
    .e delete 0 end
    .e insert end "0123456789"
    .e select from 1
    .e select to 5
    update
    .e select adjust 4
    selection get
} {123}
test entry-3.52 {EntryWidgetCmd procedure, "selection adjust" widget command} {
    .e delete 0 end
    .e insert end "0123456789"
    .e select from 1
    .e select to 5
    update
    .e select adjust 2
    selection get
} {234}
test entry-3.53 {EntryWidgetCmd procedure, "selection from" widget command} {
    list [catch {.e select from 2 3} msg] $msg
} {1 {wrong # args: should be ".e selection from index"}}
test entry-3.54 {EntryWidgetCmd procedure, "selection range" widget command} {
    list [catch {.e select range 2} msg] $msg
} {1 {wrong # args: should be ".e selection range start end"}}
test entry-3.55 {EntryWidgetCmd procedure, "selection range" widget command} {
    list [catch {.e selection range 2 3 4} msg] $msg
} {1 {wrong # args: should be ".e selection range start end"}}
test entry-3.56 {EntryWidgetCmd procedure, "selection range" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 1
    .e select to 5
    .e select range 4 4
    list [catch {.e index sel.first} msg] $msg
} {1 {selection isn't in entry}}
test entry-3.57 {EntryWidgetCmd procedure, "selection range" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 3
    .e select to 7
    .e select range 2 9
    list [.e index sel.first] [.e index sel.last] [.e index anchor]
} {2 9 3}
.e delete 0 end
.e insert end "This is quite a long text string, so long that it "
.e insert end "runs off the end of the window quite a bit."
test entry-3.58 {EntryWidgetCmd procedure, "selection to" widget command} {
    list [catch {.e select to 2 3} msg] $msg
} {1 {wrong # args: should be ".e selection to index"}}
test entry-3.59 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 5
    .e xview
} {0.0537634 0.268817}
test entry-3.60 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview gorp} msg] $msg
} {1 {bad entry index "gorp"}}
test entry-3.61 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 0
    .e icursor 10
    .e xview insert
    .e xview
} {0.107527 0.322581}
test entry-3.62 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview moveto foo bar} msg] $msg
} {1 {wrong # args: should be ".e xview moveto fraction"}}
test entry-3.63 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview moveto foo} msg] $msg
} {1 {expected floating-point number but got "foo"}}
test entry-3.64 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview moveto 0.5
    .e xview
} {0.505376 0.72043}
test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview scroll 24} msg] $msg
} {1 {wrong # args: should be ".e xview scroll number units|pages"}}
test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview scroll gorp units} msg] $msg
} {1 {expected integer but got "gorp"}}
test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview moveto 0
    .e xview scroll 1 pages
    .e xview
} {0.193548 0.408602}