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 8package require tcltest 2.2 9eval tcltest::configure $argv 10tcltest::loadTestedCommands 11namespace import -force tcltest::test 12 13test tk-1.1 {tk command: general} -body { 14 tk 15} -returnCodes error -result {wrong # args: should be "tk subcommand ?arg ...?"} 16test 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 21set appname [tk appname] 22test tk-2.1 {tk command: appname} -body { 23 tk appname xyz abc 24} -returnCodes error -result {wrong # args: should be "tk appname ?newName?"} 25test tk-2.2 {tk command: appname} -body { 26 tk appname foobazgarply 27} -result {foobazgarply} 28test 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} 32test tk-2.4 {tk command: appname} -body { 33 tk appname [tk appname] 34} -result [tk appname] 35tk appname $appname 36 37# Value stored to restore default settings after 3.* tests 38set scaling [tk scaling] 39test tk-3.1 {tk command: scaling} -body { 40 tk scaling -displayof 41} -returnCodes error -result {value for "-displayof" missing} 42test tk-3.2 {tk command: scaling: get current} -body { 43 tk scaling 1 44 format %.2g [tk scaling] 45} -result 1 46test tk-3.3 {tk command: scaling: get current} -body { 47 tk scaling -displayof . 1.25 48 format %.3g [tk scaling] 49} -result 1.25 50test tk-3.4 {tk command: scaling: set new} -body { 51 tk scaling xyz 52} -returnCodes error -result {expected floating-point number but got "xyz"} 53test 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"} 56test tk-3.6 {tk command: scaling: set new} -body { 57 tk scaling 1 58 format %.2g [tk scaling] 59} -result 1 60test tk-3.7 {tk command: scaling: set new} -body { 61 tk scaling -displayof . 1.25 62 format %.3g [tk scaling] 63} -result 1.25 64test tk-3.8 {tk command: scaling: negative} -body { 65 tk scaling -1 66 expr {[tk scaling] > 0} 67} -result {1} 68test tk-3.9 {tk command: scaling: too big} -body { 69 tk scaling 1000000 70 expr {[tk scaling] < 10000} 71} -result {1} 72test 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} 77test 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} 82tk scaling $scaling 83 84# Value stored to restore default settings after 4.* tests 85set useim [tk useinputmethods] 86test tk-4.1 {tk command: useinputmethods} -body { 87 tk useinputmethods -displayof 88} -returnCodes error -result {value for "-displayof" missing} 89test tk-4.2 {tk command: useinputmethods: get current} -body { 90 tk useinputmethods no 91} -cleanup { 92 tk useinputmethods $useim 93} -result 0 94test 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 100test tk-4.4 {tk command: useinputmethods: set new} -body { 101 tk useinputmethods xyz 102} -returnCodes error -result {expected boolean value but got "xyz"} 103test tk-4.5 {tk command: useinputmethods: set new} -body { 104 tk useinputmethods -displayof . xyz 105} -returnCodes error -result {expected boolean value but got "xyz"} 106test 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 115test 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 123test 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?"} 126test tk-5.2 {tk caret} -body { 127 tk caret bogus 128} -returnCodes error -result {bad window path name "bogus"} 129test tk-5.3 {tk caret} -body { 130 tk caret . -foo 131} -returnCodes error -result {bad caret option "-foo": must be -x, -y, or -height} 132test 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?"} 135test 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} 138test 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 143test tk-6.1 {tk inactive} -body { 144 string is integer [tk inactive] 145} -result 1 146test tk-6.2 {tk inactive reset} -body { 147 tk inactive reset 148} -returnCodes ok -match glob -result * 149test tk-6.3 {tk inactive wrong argument} -body { 150 tk inactive foo 151} -returnCodes 1 -result {bad option "foo": must be reset} 152test 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?"} 155test 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 163test 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 171test 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 183cleanupTests 184return 185