util/src/TclTk/tk8.6.12/tests/tk.test

   1 # This file is a Tcl script to test the tk command.
   2 # It is organized in the standard fashion for Tcl tests.
   3 #
   4 # Copyright (c) 1997 Sun Microsystems, Inc.
   5 # Copyright (c) 1998-1999 by Scriptics Corporation.
   6 # Copyright (c) 2002 ActiveState Corporation.
   7
   8 package require tcltest 2.2
   9 eval tcltest::configure $argv
  10 tcltest::loadTestedCommands
  11 namespace import -force tcltest::test
  12
  13 test tk-1.1 {tk command: general} -body {
  14     tk
  15 } -returnCodes error -result {wrong # args: should be "tk subcommand ?arg ...?"}
  16 test tk-1.2 {tk command: general} -body {
  17     tk xyz
  18 } -returnCodes error -result {unknown or ambiguous subcommand "xyz": must be appname, busy, caret, fontchooser, inactive, scaling, useinputmethods, or windowingsystem}
  19
  20 # Value stored to restore default settings after 2.* tests
  21 set appname [tk appname]
  22 test tk-2.1 {tk command: appname} -body {
  23     tk appname xyz abc
  24 } -returnCodes error -result {wrong # args: should be "tk appname ?newName?"}
  25 test tk-2.2 {tk command: appname} -body {
  26     tk appname foobazgarply
  27 } -result {foobazgarply}
  28 test tk-2.3 {tk command: appname} -constraints unix -body {
  29     tk appname bazfoogarply
  30     expr {[lsearch -exact [winfo interps] [tk appname]] >= 0}
  31 } -result {1}
  32 test tk-2.4 {tk command: appname} -body {
  33     tk appname [tk appname]
  34 } -result [tk appname]
  35 tk appname $appname
  36
  37 # Value stored to restore default settings after 3.* tests
  38 set scaling [tk scaling]
  39 test tk-3.1 {tk command: scaling} -body {
  40     tk scaling -displayof
  41 } -returnCodes error -result {value for "-displayof" missing}
  42 test tk-3.2 {tk command: scaling: get current} -body {
  43     tk scaling 1
  44     format %.2g [tk scaling]
  45 }  -result 1
  46 test tk-3.3 {tk command: scaling: get current} -body {
  47     tk scaling -displayof . 1.25
  48     format %.3g [tk scaling]
  49 }  -result 1.25
  50 test tk-3.4 {tk command: scaling: set new} -body {
  51     tk scaling xyz
  52 } -returnCodes error -result {expected floating-point number but got "xyz"}
  53 test tk-3.5 {tk command: scaling: set new} -body {
  54     tk scaling -displayof . xyz
  55 } -returnCodes error -result {expected floating-point number but got "xyz"}
  56 test tk-3.6 {tk command: scaling: set new} -body {
  57     tk scaling 1
  58     format %.2g [tk scaling]
  59 } -result 1
  60 test tk-3.7 {tk command: scaling: set new} -body {
  61     tk scaling -displayof . 1.25
  62     format %.3g [tk scaling]
  63 } -result 1.25
  64 test tk-3.8 {tk command: scaling: negative} -body {
  65     tk scaling -1
  66     expr {[tk scaling] > 0}
  67 } -result {1}
  68 test tk-3.9 {tk command: scaling: too big} -body {
  69     tk scaling 1000000
  70     expr {[tk scaling] < 10000}
  71 } -result {1}
  72 test tk-3.10 {tk command: scaling: widthmm} -body {
  73     tk scaling 1.25
  74     expr {int((25.4*[winfo screenwidth .])/(72*1.25) + 0.5) \
  75         - [winfo screenmmwidth .]}
  76 } -result {0}
  77 test tk-3.11 {tk command: scaling: heightmm} -body {
  78     tk scaling 1.25
  79     expr {int((25.4*[winfo screenheight .])/(72*1.25) + 0.5) \
  80         - [winfo screenmmheight .]}
  81 } -result {0}
  82 tk scaling $scaling
  83
  84 # Value stored to restore default settings after 4.* tests
  85 set useim [tk useinputmethods]
  86 test tk-4.1 {tk command: useinputmethods} -body {
  87     tk useinputmethods -displayof
  88 } -returnCodes error -result {value for "-displayof" missing}
  89 test tk-4.2 {tk command: useinputmethods: get current} -body {
  90     tk useinputmethods no
  91 } -cleanup {
  92     tk useinputmethods $useim
  93 } -result 0
  94 test tk-4.3 {tk command: useinputmethods: get current} -body {
  95     tk useinputmethods no
  96     tk useinputmethods -displayof .
  97 } -cleanup {
  98     tk useinputmethods $useim
  99 } -result 0
 100 test tk-4.4 {tk command: useinputmethods: set new} -body {
 101     tk useinputmethods xyz
 102 } -returnCodes error -result {expected boolean value but got "xyz"}
 103 test tk-4.5 {tk command: useinputmethods: set new} -body {
 104     tk useinputmethods -displayof . xyz
 105 } -returnCodes error -result {expected boolean value but got "xyz"}
 106 test tk-4.6 {tk command: useinputmethods: set new} -body {
 107     # This isn't really a test, but more of a check... The answer is what was
 108     # given, because we may be on a Unix system that doesn't have the XIM
 109     # stuff
 110     if {[tk useinputmethods 1] == 0} {
 111         puts "this wish doesn't have XIM (X Input Methods) support"
 112     }
 113     return $useim
 114 } -result $useim
 115 test tk-4.7 {tk command: useinputmethods: set new} -constraints win -body {
 116     # Mac and Windows don't have X Input Methods, so this should always return
 117     # 0
 118     tk useinputmethods 1
 119 } -cleanup {
 120     tk useinputmethods $useim
 121 } -result 0
 122
 123 test tk-5.1 {tk caret} -body {
 124     tk caret
 125 } -returnCodes error -result {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}
 126 test tk-5.2 {tk caret} -body {
 127     tk caret bogus
 128 } -returnCodes error -result {bad window path name "bogus"}
 129 test tk-5.3 {tk caret} -body {
 130     tk caret . -foo
 131 } -returnCodes error -result {bad caret option "-foo": must be -x, -y, or -height}
 132 test tk-5.4 {tk caret} -body {
 133     tk caret . -x 0 -y
 134 } -returnCodes error -result {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}
 135 test tk-5.5 {tk caret} -body {
 136     tk caret . -x 10 -y 11 -h 12; tk caret .
 137 } -result {-height 12 -x 10 -y 11}
 138 test tk-5.6 {tk caret} -body {
 139     tk caret . -x 20 -y 25 -h 30; tk caret . -hei
 140 } -result {30}
 141
 142 # tk inactive
 143 test tk-6.1 {tk inactive} -body {
 144     string is integer [tk inactive]
 145 } -result 1
 146 test tk-6.2 {tk inactive reset} -body {
 147     tk inactive reset
 148 } -returnCodes ok -match glob -result *
 149 test tk-6.3 {tk inactive wrong argument} -body {
 150     tk inactive foo
 151 } -returnCodes 1 -result {bad option "foo": must be reset}
 152 test tk-6.4 {tk inactive too many arguments} -body {
 153     tk inactive reset foo
 154 } -returnCodes 1 -result {wrong # args: should be "tk inactive ?-displayof window? ?reset?"}
 155 test tk-6.5 {tk inactive} -body {
 156     tk inactive reset
 157     update
 158     after 100
 159     set i [tk inactive]
 160     expr {$i < 0 || ( $i > 90 && $i < 300 )}
 161 } -result 1
 162
 163 test tk-7.1 {tk inactive in a safe interpreter} -body {
 164 # tk inactive in safe interpreters
 165     safe::interpCreate foo
 166     safe::loadTk foo
 167     foo eval {tk inactive}
 168 } -cleanup {
 169     ::safe::interpDelete foo
 170 } -result -1
 171 test tk-7.2 {tk inactive reset in a safe interpreter} -body {
 172 # tk inactive in safe interpreters
 173     safe::interpCreate foo
 174     safe::loadTk foo
 175     foo eval {tk inactive reset}
 176 } -cleanup {
 177     ::safe::interpDelete foo
 178 } -returnCodes 1 -result {resetting the user inactivity timer is not allowed in a safe interpreter}
 179
 180 # tests of [tk busy] in busy.test
 181
 182 # cleanup
 183 cleanupTests
 184 return