tk/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 # All rights reserved.
   7 #
   8 # RCS: @(#) $Id$
   9
  10 if {[lsearch [namespace children] ::tcltest] == -1} {
  11     source [file join [pwd] [file dirname [info script]] defs.tcl]
  12 }
  13
  14 test tk-1.1 {tk command: general} {
  15     list [catch {tk} msg] $msg
  16 } {1 {wrong # args: should be "tk option ?arg?"}}
  17 test tk-1.2 {tk command: general} {
  18     list [catch {tk xyz} msg] $msg
  19 } {1 {bad option "xyz": must be appname, scaling, or useinputmethods}}
  20
  21 set appname [tk appname]
  22 test tk-2.1 {tk command: appname} {
  23     list [catch {tk appname xyz abc} msg] $msg
  24 } {1 {wrong # args: should be "tk appname ?newName?"}}
  25 test tk-2.2 {tk command: appname} {
  26     tk appname foobazgarply
  27 } {foobazgarply}
  28 test tk-2.3 {tk command: appname} {unixOnly} {
  29     tk appname bazfoogarply
  30     expr {[lsearch -exact [winfo interps] [tk appname]] >= 0}
  31 } {1}
  32 test tk-2.4 {tk command: appname} {
  33     tk appname $appname
  34 } $appname
  35 tk appname $appname
  36
  37 set scaling [tk scaling]
  38 test tk-3.1 {tk command: scaling} {
  39     list [catch {tk scaling -displayof} msg] $msg
  40 } {1 {value for "-displayof" missing}}
  41 test tk-3.2 {tk command: scaling: get current} {
  42     tk scaling 1
  43     format %.2g [tk scaling]
  44 } 1
  45 test tk-3.3 {tk command: scaling: get current} {
  46     tk scaling -displayof . 1.25
  47     format %.3g [tk scaling]
  48 } 1.25
  49 test tk-3.4 {tk command: scaling: set new} {
  50     list [catch {tk scaling xyz} msg] $msg
  51 } {1 {expected floating-point number but got "xyz"}}
  52 test tk-3.5 {tk command: scaling: set new} {
  53     list [catch {tk scaling -displayof . xyz} msg] $msg
  54 } {1 {expected floating-point number but got "xyz"}}
  55 test tk-3.6 {tk command: scaling: set new} {
  56     tk scaling 1
  57     format %.2g [tk scaling]
  58 } 1
  59 test tk-3.7 {tk command: scaling: set new} {
  60     tk scaling -displayof . 1.25
  61     format %.3g [tk scaling]
  62 } 1.25
  63 test tk-3.8 {tk command: scaling: negative} {
  64     tk scaling -1
  65     expr {[tk scaling] > 0}
  66 } {1}
  67 test tk-3.9 {tk command: scaling: too big} {
  68     tk scaling 1000000
  69     expr {[tk scaling] < 10000}
  70 } {1}
  71 test tk-3.10 {tk command: scaling: widthmm} {
  72     tk scaling 1.25
  73     expr {int((25.4*[winfo screenwidth .])/(72*1.25)+0.5)-[winfo screenmmwidth .]}
  74 } {0}
  75 test tk-3.11 {tk command: scaling: heightmm} {
  76     tk scaling 1.25
  77     expr {int((25.4*[winfo screenheight .])/(72*1.25)+0.5)-[winfo screenmmheight .]}
  78 } {0}
  79 tk scaling $scaling
  80
  81 set useim [tk useinputmethods]
  82 test tk-4.1 {tk command: useinputmethods} {
  83     list [catch {tk useinputmethods -displayof} msg] $msg
  84 } {1 {value for "-displayof" missing}}
  85 test tk-4.2 {tk command: useinputmethods: get current} {
  86     tk useinputmethods no
  87 } 0
  88 test tk-4.3 {tk command: useinputmethods: get current} {
  89     tk useinputmethods -displayof .
  90 } 0
  91 test tk-4.4 {tk command: useinputmethods: set new} {
  92     list [catch {tk useinputmethods xyz} msg] $msg
  93 } {1 {expected boolean value but got "xyz"}}
  94 test tk-4.5 {tk command: useinputmethods: set new} {
  95     list [catch {tk useinputmethods -displayof . xyz} msg] $msg
  96 } {1 {expected boolean value but got "xyz"}}
  97 test tk-4.6 {tk command: useinputmethods: set new} {unixOnly} {
  98     # This isn't really a test, but more of a check...
  99     # The answer is what was given, because we may be on a Unix
 100     # system that doesn't have the XIM stuff
 101     if {[tk useinputmethods 1] == 0} {
 102         puts "this wish doesn't have XIM (X Input Methods) support"
 103     }
 104     # We should always start with XIM support off
 105     set useim
 106 } 0
 107 test tk-4.7 {tk command: useinputmethods: set new} {macOrPc} {
 108     # Mac and Windows don't have X Input Methods, so this should
 109     # always return 0
 110     tk useinputmethods 1
 111 } 0
 112 tk useinputmethods $useim
 113
 114 # cleanup
 115 ::tcltest::cleanupTests
 116 return