Updated to tk 8.4.1

[pf3gnuchains/sourceware.git] / tk / tests / listbox.test

diff --git a/tk/tests/listbox.test b/tk/tests/listbox.test
index 900ad1f..800655e 100644 (file)
--- a/tk/tests/listbox.test
+++ b/tk/tests/listbox.test
@@ -8,15 +8,13 @@
 #
 # RCS: @(#) $Id$
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
 
-foreach i [winfo children .] {
-    destroy $i
-}
-wm geometry . {}
-raise .
 set fixed {Courier -12}
 
 proc record args {
@@ -73,12 +71,14 @@ resetGridInfo
 set i 1
 
 foreach test {
+    {-activestyle under underline foo {bad activestyle "foo": must be dotbox, none, or underline}}
     {-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"}}
+    {-disabledforeground #110022 #110022 bogus {unknown color name "bogus"}}
     {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}}
     {-fg #110022 #110022 bogus {unknown color name "bogus"}}
     {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
@@ -94,6 +94,7 @@ foreach test {
     {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
     {-selectmode string string {} {}}
     {-setgrid false 0 lousy {expected boolean value but got "lousy"}}
+    {-state disabled disabled foo {bad state "foo": must be disabled or normal}}
     {-takefocus "any string" "any string" {} {}}
     {-width 45 45 3p {expected integer but got "3p"}}
     {-xscrollcommand {Some command} {Some command} {} {}}
@@ -239,7 +240,7 @@ test listbox-3.22 {ListboxWidgetCmd procedure, "cget" option} {
 } {0}
 test listbox-3.23 {ListboxWidgetCmd procedure, "configure" option} {
     llength [.l configure]
-} {24}
+} {27}
 test listbox-3.24 {ListboxWidgetCmd procedure, "configure" option} {
     list [catch {.l configure -gorp} msg] $msg
 } {1 {unknown option "-gorp"}}
@@ -938,11 +939,19 @@ test listbox-4.18 {ConfigureListbox, no listvar -> bad listvar} {
     catch {destroy .l}
     listbox .l
     .l insert end a b c d
-    set x {this is a " bad list}
+    set x "this is a \" bad list"
     catch {.l configure -listvar x} result
     list [.l get 0 end] [.l cget -listvar] $result
 } [list [list a b c d] {} \
-       "unmatched open quote in list: invalid listvar value"]
+       "unmatched open quote in list: invalid -listvariable value"]
+test listbox-4.19 {ConfigureListbox, no listvar -> bad non-existent listvar} {
+    catch {destroy .l}
+    listbox .l -listvar foo
+    .l insert end a b c d
+    catch {.l configure -listvar ::zoo::bar::foo} result
+    list [.l get 0 end] [.l cget -listvar] $foo $result
+} [list [list a b c d] foo [list a b c d] \
+       {can't set "::zoo::bar::foo": parent namespace doesn't exist}]
 
 # No tests for DisplayListbox:  I don't know how to test this procedure.
 
@@ -1286,7 +1295,7 @@ test listbox-8.2 {ListboxEventProc procedure} {fonts} {
     list [.l xview] [.l yview]
 } {{0 0.222222} {0 0.333333}}
 test listbox-8.3 {ListboxEventProc procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     listbox .l1 -bg #543210
     rename .l1 .l2
     set x {}
@@ -1297,7 +1306,7 @@ test listbox-8.3 {ListboxEventProc procedure} {
 } {.l1 #543210 {} {}}
 
 test listbox-9.1 {ListboxCmdDeletedProc procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     listbox .l1
     rename .l1 {}
     list [info command .l*] [winfo children .]
@@ -1740,7 +1749,7 @@ test listbox-19.2 {ListboxUpdateVScrollbar procedure} {
     (horizontal scrolling command executed by listbox)}}
 
 set l [interp hidden]
-eval destroy [winfo children .]
+deleteWindows
 
 test listbox-20.1 {listbox vs hidden commands} {
     catch {destroy .l}
@@ -1846,7 +1855,7 @@ test listbox-21.11 {ListboxListVarProc, bad list} {
     catch {unset x}
     listbox .l -listvar x
     set x [list a b c d]
-    catch {set x {this is a " bad list}} result
+    catch {set x "this is a \" bad list"} result
     set result
 } {can't set "x": invalid listvar value}
 test listbox-21.12 {ListboxListVarProc, cleanup item attributes} {
@@ -1964,7 +1973,7 @@ test listbox-23.5 {ConfigureListboxItem, multiple calls} {
     catch {destroy .l}
     listbox .l
     set i 0
-    foreach color {red orange yellow green blue darkblue violet} {
+    foreach color {red orange yellow green blue white violet} {
        .l insert end $color
        .l itemconfigure $i -bg $color
        incr i
@@ -1974,7 +1983,7 @@ test listbox-23.5 {ConfigureListboxItem, multiple calls} {
     list [.l itemcget 0 -bg] [.l itemcget 1 -bg] [.l itemcget 2 -bg] \
            [.l itemcget 3 -bg] [.l itemcget 4 -bg] [.l itemcget 5 -bg] \
            [.l itemcget 6 -bg]
-} {red orange yellow green blue darkblue violet}
+} {red orange yellow green blue white violet}
 catch {destroy .l}
 listbox .l
 .l insert end a b c d
@@ -1995,7 +2004,7 @@ foreach test {
     } [list [lindex $test 2] [lindex $test 2]]
     incr i
     if {[lindex $test 3] != ""} {
-       test listbox-1.$i {configuration options} {
+       test listbox-23.$i {configuration options} {
            list [catch {.l configure $name [lindex $test 3]} msg] $msg
        } [list 1 [lindex $test 4]]
     }
@@ -2051,13 +2060,80 @@ test listbox-25.2 {listbox item configurations and widget based inserts} {
     list [.l itemcget 0 -fg] [.l itemcget 4 -fg]
 } [list {} red]
     
+# state issues
+test listbox-26.1 {listbox disabled state disallows inserts} {
+    catch {destroy .l}
+    listbox .l
+    .l insert end a b c
+    .l configure -state disabled
+    .l insert end d e f
+    .l get 0 end
+} [list a b c]
+test listbox-26.2 {listbox disabled state disallows deletions} {
+    catch {destroy .l}
+    listbox .l
+    .l insert end a b c
+    .l configure -state disabled
+    .l delete 0 end
+    .l get 0 end
+} [list a b c]
+test listbox-26.3 {listbox disabled state disallows selection modification} {
+    catch {destroy .l}
+    listbox .l
+    .l insert end a b c
+    .l selection set 0
+    .l selection set 2
+    .l configure -state disabled
+    .l selection clear 0 end
+    .l selection set 1
+    .l curselection
+} [list 0 2]
+test listbox-26.4 {listbox disabled state disallows anchor modification} {
+    catch {destroy .l}
+    listbox .l
+    .l insert end a b c
+    .l selection anchor 0
+    .l configure -state disabled
+    .l selection anchor 2
+    .l index anchor
+} 0
+test listbox-26.5 {listbox disabled state disallows active modification} {
+    catch {destroy .l}
+    listbox .l
+    .l insert end a b c
+    .l activate 0
+    .l configure -state disabled
+    .l activate 2
+    .l index active
+} 0
+
+test listbox-27.1 {widget deletion while active} {
+    destroy .l
+    pack [listbox .l]
+    update
+    .l configure -cursor xterm -xscrollcommand { destroy .l }
+    update idle
+    winfo exists .l
+} 0
 
+test listbox-28.1 {listbox -activestyle} {
+    catch {destroy .l}
+    listbox .l -activ non
+    .l cget -activestyle
+} none
+test listbox-28.2 {listbox -activestyle} {
+    catch {destroy .l}
+    listbox .l
+    .l cget -activestyle
+} underline
+test listbox-28.3 {listbox -activestyle} {
+    catch {destroy .l}
+    listbox .l -activestyle dot
+    .l cget -activestyle
+} dotbox
 
 resetGridInfo
-catch {destroy .l2}
-catch {destroy .t}
-catch {destroy .e}
-catch {destroy .partial}
+deleteWindows
 option clear
 
 # cleanup