select.test

linux系统下的音频通信

    update
    cleanupbg
    lappend result [selection own]
} {{} {}}

# multiple display tests
if {[info exists env(TK_ALT_DISPLAY)]} {
    test select-4.5 {Tk_ClearSelection procedure} {
	global lostSel lostSel2
	setup .f1
	setup .f2 $env(TK_ALT_DISPLAY)
	set lostSel {owned}
	set lostSel2 {owned2}
	selection own -command { set lostSel {lost1} } .f1
	selection own -command { set lostSel2 {lost2} } .f2
	update
	selection clear -displayof .f2
	update
	list $lostSel $lostSel2
    } {owned lost2}
    test select-4.6 {Tk_ClearSelection procedure} {unixOnly} {
	setup .f1
	setup .f2 $env(TK_ALT_DISPLAY)
	setupbg
	set lostSel {owned}
	set lostSel2 {owned2}
	selection own -command { set lostSel {lost1} } .f1
	selection own -command { set lostSel2 {lost2} } .f2
	update
	set result ""
	lappend result [dobg "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection own .t; update"]
	lappend result [selection own -displayof .f1] \
	    [selection own -displayof .f2] $lostSel $lostSel2
	cleanupbg
	set result
    } {{} .f1 {} owned lost2}

}
##############################################################################

test select-5.1 {Tk_GetSelection procedure} {
    setup
    list [catch {selection get TEST} msg] $msg
} {1 {PRIMARY selection doesn't exist or form "TEST" not defined}}
test select-5.2 {Tk_GetSelection procedure} {
    setup
    selection get TK_WINDOW
} {.f1}
test select-5.3 {Tk_GetSelection procedure} {
    setup
    selection handle -selection PRIMARY .f1 {handler TEST} TEST
    set selValue "Test value"
    set selInfo ""
    list [selection get TEST] $selInfo
} {{Test value} {TEST 0 4000}}
test select-5.4 {Tk_GetSelection procedure} {
    setup
    selection handle .f1 ERROR errHandler
    list [catch {selection get ERROR} msg] $msg
} {1 {PRIMARY selection doesn't exist or form "ERROR" not defined}}
test select-5.5 {Tk_GetSelection procedure} {
    setup
    set selValue $longValue
    set selInfo ""
    selection handle .f1 {handler STRING}
    list [selection get] $selInfo
} "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000}"
test select-5.6 {Tk_GetSelection procedure} {
    proc weirdHandler {type offset count} {
	selection handle .f1 {}
	handler $type $offset $count
    }
    setup
    set selValue $longValue
    set selInfo ""
    selection handle .f1 {weirdHandler STRING}
    list [catch {selection get} msg] $msg
} {1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
test select-5.7 {Tk_GetSelection procedure} {
    proc weirdHandler {type offset count} {
	destroy .f1
	handler $type $offset $count
    }
    setup
    set selValue "Test Value"
    set selInfo ""
    selection handle .f1 {weirdHandler STRING}
    list [catch {selection get} msg] $msg
} {1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
test select-5.8 {Tk_GetSelection procedure} {
    proc weirdHandler {type offset count} {
	selection clear
	handler $type $offset $count
    }
    setup
    set selValue $longValue
    set selInfo ""
    selection handle .f1 {weirdHandler STRING}
    list [selection get] $selInfo [catch {selection get} msg] $msg
} "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000} 1 {PRIMARY selection doesn't exist or form \"STRING\" not defined}"
test select-5.9 {Tk_GetSelection procedure} {unixOnly} {
    setup
    setupbg
    selection handle -selection PRIMARY .f1 {handler TEST} TEST
    update
    set selValue "Test value"
    set selInfo ""
    set result ""
    lappend result [dobg {selection get TEST}]
    cleanupbg
    lappend result $selInfo
} {{Test value} {TEST 0 4000}}
test select-5.10 {Tk_GetSelection procedure} {unixOnly} {
    setup
    setupbg
    selection handle -selection PRIMARY .f1 {handler TEST} TEST
    update
    set selValue "Test value"
    set selInfo ""
    selection own .f1
    set result ""
    fileevent $fd readable {}
    puts $fd {catch {selection get TEST} msg; update; puts $msg; flush stdout}
    flush $fd
    lappend result [gets $fd]
    cleanupbg
    lappend result $selInfo
} {{selection owner didn't respond} {}}

# multiple display tests
if {[info exists env(TK_ALT_DISPLAY)]} {
    test select-5.11 {Tk_GetSelection procedure} {
	setup .f1
	setup .f2 $env(TK_ALT_DISPLAY)
	selection handle -selection PRIMARY .f1 {handler TEST} TEST
	selection handle -selection PRIMARY .f2 {handler TEST2} TEST
	set selValue "Test value"
	set selInfo ""
	set result [list [selection get TEST] $selInfo]
	set selValue "Test value2"
	set selInfo ""
	lappend result [selection get -displayof .f2 TEST] $selInfo
    } {{Test value} {TEST 0 4000} {Test value2} {TEST2 0 4000}}
    test select-5.12 {Tk_GetSelection procedure} {
	global lostSel lostSel2
	setup .f1
	setup .f2 $env(TK_ALT_DISPLAY)
	selection handle -selection PRIMARY .f1 {handler TEST} TEST
	selection handle -selection PRIMARY .f2 {} TEST
	set selValue "Test value"
	set selInfo ""
	set result [list [catch {selection get TEST} msg] $msg $selInfo]
	set selValue "Test value2"
	set selInfo ""
	lappend result [catch {selection get -displayof .f2 TEST} msg] $msg \
	    $selInfo
    } {0 {Test value} {TEST 0 4000} 1 {PRIMARY selection doesn't exist or form "TEST" not defined} {}}
    test select-5.13 {Tk_GetSelection procedure} {unixOnly} {
	setup .f1
	setup .f2 $env(TK_ALT_DISPLAY)
	setupbg
	selection handle -selection PRIMARY .f1 {handler TEST} TEST
	selection own .f1
	selection handle -selection PRIMARY .f2 {handler TEST2} TEST
	selection own .f2
	set selValue "Test value"
	set selInfo ""
	update
	set result ""
	lappend result [dobg "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection get -displayof .t TEST"]
	set selValue "Test value2"
	lappend result [dobg "selection get TEST"]
	cleanupbg
	lappend result $selInfo
    } {{Test value} {Test value2} {TEST2 0 4000 TEST 0 4000}}
    test select-5.14 {Tk_GetSelection procedure} {unixOnly} {
	setup .f1
	setup .f2 $env(TK_ALT_DISPLAY)
	setupbg
	selection handle -selection PRIMARY .f1 {handler TEST} TEST
	selection own .f1
	selection handle -selection PRIMARY .f2 {} TEST
	selection own .f2
	set selValue "Test value"
	set selInfo ""
	update
	set result ""
	lappend result [dobg "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection get -displayof .t TEST"]
	set selValue "Test value2"
	lappend result [dobg "selection get TEST"]
	cleanupbg
	lappend result $selInfo
    } {{PRIMARY selection doesn't exist or form "TEST" not defined} {Test value2} {TEST 0 4000}}

}
##############################################################################

test select-6.1 {Tk_SelectionCmd procedure} {
    list [catch {selection} cmd] $cmd
} {1 {wrong # args: should be "selection option ?arg arg ...?"}}

# selection clear
test select-6.2 {Tk_SelectionCmd procedure} {
    list [catch {selection clear -selection} cmd] $cmd
} {1 {value for "-selection" missing}}
test select-6.3 {Tk_SelectionCmd procedure} {
    setup
    selection own .
    set result [selection own]
    selection clear -displayof .f1
    lappend result [selection own]
} {. {}}
test select-6.4 {Tk_SelectionCmd procedure} {
    setup
    selection own -selection CLIPBOARD .f1
    set result [list [selection own] [selection own -selection CLIPBOARD]]
    selection clear -selection CLIPBOARD .f1
    lappend result [selection own] [selection own -selection CLIPBOARD]
} {.f1 .f1 .f1 {}}
test select-6.5 {Tk_SelectionCmd procedure} {
    setup
    selection own -selection CLIPBOARD .
    set result [list [selection own] [selection own -selection CLIPBOARD]]
    selection clear -selection CLIPBOARD -displayof .f1
    lappend result [selection own] [selection own -selection CLIPBOARD]
} {.f1 . .f1 {}}
test select-6.6 {Tk_SelectionCmd procedure} {
    list [catch {selection clear -badopt foo} cmd] $cmd
} {1 {unknown option "-badopt"}}
test select-6.7 {Tk_SelectionCmd procedure} {
    list [catch {selection clear -selectionfoo foo} cmd] $cmd
} {1 {unknown option "-selectionfoo"}}
test select-6.8 {Tk_SelectionCmd procedure} {
    catch {destroy .f2}
    list [catch {selection clear -displayof .f2} cmd] $cmd
} {1 {bad window path name ".f2"}}
test select-6.9 {Tk_SelectionCmd procedure} {
    catch {destroy .f2}
    list [catch {selection clear .f2} cmd] $cmd
} {1 {bad window path name ".f2"}}
test select-6.10 {Tk_SelectionCmd procedure} {
    setup
    set result [selection own -selection PRIMARY]
    selection clear
    lappend result [selection own -selection PRIMARY]
} {.f1 {}}
test select-6.11 {Tk_SelectionCmd procedure} {
    setup
    selection own -selection CLIPBOARD .f1
    set result [selection own -selection CLIPBOARD]
    selection clear -selection CLIPBOARD
    lappend result [selection own -selection CLIPBOARD]
} {.f1 {}}
test select-6.12 {Tk_SelectionCmd procedure} {
    list [catch {selection clear foo bar} cmd] $cmd
} {1 {wrong # args: should be "selection clear ?options?"}}

# selection get
test select-6.13 {Tk_SelectionCmd procedure} {
    list [catch {selection get -selection} cmd] $cmd
} {1 {value for "-selection" missing}}
test select-6.14 {Tk_SelectionCmd procedure} {
    global selValue selInfo
    setup
    selection handle .f1 {handler TEST}
    set selValue "Test value"
    set selInfo ""
    list [selection get -displayof .f1] $selInfo
} {{Test value} {TEST 0 4000}}
test select-6.15 {Tk_SelectionCmd procedure} {
    global selValue selInfo
    setup
    selection handle .f1 {handler STRING}
    selection handle -selection CLIPBOARD .f1 {handler TEST}
    selection own -selection CLIPBOARD .f1
    set selValue "Test value"
    set selInfo ""
    list [selection get -selection CLIPBOARD] $selInfo
} {{Test value} {TEST 0 4000}}
test select-6.16 {Tk_SelectionCmd procedure} {
    global selValue selInfo
    setup
    selection handle -type TEST .f1 {handler TEST}
    selection handle -type STRING .f1 {handler STRING}
    set selValue "Test value"
    set selInfo ""
    list [selection get -type TEST] $selInfo
} {{Test value} {TEST 0 4000}}
test select-6.17 {Tk_SelectionCmd procedure} {
    list [catch {selection get -badopt foo} cmd] $cmd
} {1 {unknown option "-badopt"}}
test select-6.18 {Tk_SelectionCmd procedure} {
    list [catch {selection get -selectionfoo foo} cmd] $cmd
} {1 {unknown option "-selectionfoo"}}
test select-6.19 {Tk_SelectionCmd procedure} {
    catch { destroy .f2 }
    list [catch {selection get -displayof .f2} cmd] $cmd
} {1 {bad window path name ".f2"}}
test select-6.20 {Tk_SelectionCmd procedure} {
    list [catch {selection get foo bar} cmd] $cmd
} {1 {wrong # args: should be "selection get ?options?"}}
test select-6.21 {Tk_SelectionCmd procedure} {
    global selValue selInfo
    setup
    selection handle -type TEST .f1 {handler TEST}
    selection handle -type STRING .f1 {handler STRING}
    set selValue "Test value"
    set selInfo ""
    list [selection get TEST] $selInfo
} {{Test value} {TEST 0 4000}}

# selection handle
# most of the handle section has been covered earlier
test select-6.22 {Tk_SelectionCmd procedure} {
    list [catch {selection handle -selection} cmd] $cmd
} {1 {value for "-selection" missing}}
test select-6.23 {Tk_SelectionCmd procedure} {
    global selValue selInfo
    setup
    set selValue "Test value"
    set selInfo ""
    list [selection handle -format INTEGER .f1 {handler TEST}] [selection get -displayof .f1] $selInfo
} {{} {Test value} {TEST 0 4000}}
test select-6.24 {Tk_SelectionCmd procedure} {
    list [catch {selection handle -badopt foo} cmd] $cmd
} {1 {unknown option "-badopt"}}
test select-6.25 {Tk_SelectionCmd procedure} {
    list [catch {selection handle -selectionfoo foo} cmd] $cmd
} {1 {unknown option "-selectionfoo"}}
test select-6.26 {Tk_SelectionCmd procedure} {