#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
-# All rights reserved.
+# Copyright (c) 2002 ActiveState Corporation.
#
# 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
test tk-1.1 {tk command: general} {
list [catch {tk} msg] $msg
} {1 {wrong # args: should be "tk option ?arg?"}}
test tk-1.2 {tk command: general} {
list [catch {tk xyz} msg] $msg
-} {1 {bad option "xyz": must be appname, scaling, or useinputmethods}}
+} {1 {bad option "xyz": must be appname, caret, scaling, useinputmethods, or windowingsystem}}
set appname [tk appname]
test tk-2.1 {tk command: appname} {
if {[tk useinputmethods 1] == 0} {
puts "this wish doesn't have XIM (X Input Methods) support"
}
- # We should always start with XIM support off
set useim
-} 0
+} $useim
test tk-4.7 {tk command: useinputmethods: set new} {macOrPc} {
# Mac and Windows don't have X Input Methods, so this should
# always return 0
} 0
tk useinputmethods $useim
+test tk-5.1 {tk caret} {
+ list [catch {tk caret} msg] $msg
+} {1 {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}}
+test tk-5.2 {tk caret} {
+ list [catch {tk caret bogus} msg] $msg
+} {1 {bad window path name "bogus"}}
+test tk-5.3 {tk caret} {
+ list [catch {tk caret . -foo} msg] $msg
+} {1 {bad caret option "-foo": must be -x, -y, or -height}}
+test tk-5.4 {tk caret} {
+ list [catch {tk caret . -x 0 -y} msg] $msg
+} {1 {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}}
+test tk-5.5 {tk caret} {
+ list [catch {tk caret . -x 10 -y 11 -h 12; tk caret .} msg] $msg
+} {0 {-height 12 -x 10 -y 11}}
+test tk-5.6 {tk caret} {
+ list [catch {tk caret . -x 20 -y 25 -h 30; tk caret . -hei} msg] $msg
+} {0 30}
+
# cleanup
::tcltest::cleanupTests
return