File: ttkComboboxPlus.test

package info (click to toggle)
tklib 0.7%2B20210111-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 17,676 kB
  • sloc: tcl: 82,240; sh: 5,801; ansic: 792; pascal: 359; makefile: 70; sed: 53; exp: 21
file content (100 lines) | stat: -rw-r--r-- 2,954 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
# -*- tcl -*-

if {![package vsatisfies [package provide Tcl] 8.5]} {
    puts "    Aborting the tests found in \"[file tail [info script]]\"."
    puts "    Requiring Tcl 8.5, have [package present Tcl]"
    return
}

# Future: put all tests under constraint tk and set constraint properly
if {[catch { package require Tk 8.5 } msg]} {
    puts "    Aborting the tests found in \"[file tail [info script]]\"."
    puts "    Requiring Tk 8.5, $msg"
    return
}

::tcltest::testConstraint tk 1

#
# ttk::combobox widget tests
#

package require Tk 8.5
package require tcltest ; namespace import -force tcltest::*
loadTestedCommands

package require widgetPlus
namespace import ::widgetPlus::ttkComboboxPlus

# ------------------------------------------------------------------------------
# This file is copied from ttk/combobox.test, with addition of the two lines
# above, application of "s/ttk::combobox/ttkComboboxPlus/g" to widget
# constructors in the code, but not to commands ttk::combobox::* (and not to
# comments, results, test names or other metadata).
#
# The purpose is to check that "ttkComboboxPlus" does not break any features of
# "ttk::combobox", including important matters such as validation.
#
# All tests pass.
# ------------------------------------------------------------------------------

test combobox-1.0 "Combobox tests -- setup" -body {
    ttkComboboxPlus .cb
} -result .cb

test combobox-1.1 "Bad -values list" -body {
    .cb configure -values "bad \{list"
} -result "unmatched open brace in list" -returnCodes 1

test combobox-1.end "Combobox tests -- cleanup" -body {
    destroy .cb
}

test combobox-2.0 "current command" -body {
    ttkComboboxPlus .cb -values [list a b c d e a]
    .cb current
} -result -1

test combobox-2.1 "current -- set index" -body {
    .cb current 5
    .cb get
} -result a

test combobox-2.2 "current -- change -values" -body {
    .cb configure -values [list c b a d e]
    .cb current
} -result 2

test combobox-2.3 "current -- change value" -body {
    .cb set "b"
    .cb current
} -result 1

test combobox-2.4 "current -- value not in list" -body { 
    .cb set "z"
    .cb current
} -result -1

test combobox-2.end "Cleanup" -body { destroy .cb }


test combobox-1890211 "ComboboxSelected event after listbox unposted" -body {
    # whitebox test...
    pack [ttkComboboxPlus .cb -values [list a b c]]
    set result [list]
    bind .cb <<ComboboxSelected>> {
    	lappend result Event [winfo ismapped .cb.popdown] [.cb get]
    }
    lappend result Start 0 [.cb get]
    ttk::combobox::Post .cb
    lappend result Post [winfo ismapped .cb.popdown] [.cb get]
    .cb.popdown.f.l selection clear 0 end; .cb.popdown.f.l selection set 1
    ttk::combobox::LBSelected .cb.popdown.f.l
    lappend result Select [winfo ismapped .cb.popdown] [.cb get]
    update
    set result
} -result [list Start 0 {} Post 1 {} Select 0 b Event 0 b] -cleanup {
    destroy .cb
}

tcltest::cleanupTests