From 5d79f1ca560bb8be052c404b6bf7e413f4287d3a Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 12 Jul 2002 21:08:47 +0000 Subject: * Converted several files in the Tk test suite for testing by tcltest 2.1. FossilOrigin-Name: 4b0cdc1bb7ef77230512e5c3d8aa7d8286082c7a --- ChangeLog | 4 +- tests/text.test | 15 ++- tests/textBTree.test | 8 +- tests/textDisp.test | 19 ++-- tests/textImage.test | 29 ++---- tests/textIndex.test | 20 ++-- tests/textMark.test | 94 +++++++++---------- tests/textTag.test | 257 +++++++++++++++++++++++++-------------------------- tests/textWind.test | 15 ++- tests/tk.test | 8 +- tests/unixWm.test | 190 ++++++++++++++++++------------------- 11 files changed, 326 insertions(+), 333 deletions(-) diff --git a/ChangeLog b/ChangeLog index 50f421b..da65c9f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,8 +1,8 @@ 2002-07-11 Don Porter - + * tests/canvPsImg.tcl: Converted several files in the * tests/constraints.tcl (new file): Tk test suite for testing by - * tests/[u-x]*.test: tcltest 2.1. + * tests/[t-x]*.test: tcltest 2.1. * unix/Makefile.in: 2002-07-11 Jeff Hobbs diff --git a/tests/text.test b/tests/text.test index a6bfc19..7ae80a0 100644 --- a/tests/text.test +++ b/tests/text.test @@ -6,11 +6,16 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: text.test,v 1.16 2002/06/22 08:21:52 hobbs Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} +# RCS: @(#) $Id: text.test,v 1.17 2002/07/12 21:08:49 dgp Exp $ + +package require tcltest 2.1 +namespace import -force tcltest::test +namespace import -force tcltest::testsDirectory +namespace import -force tcltest::configure +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands +eval configure $argv eval destroy [winfo child .] diff --git a/tests/textBTree.test b/tests/textBTree.test index 855a8f3..9088f28 100644 --- a/tests/textBTree.test +++ b/tests/textBTree.test @@ -8,11 +8,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textBTree.test,v 1.3 1999/04/16 01:51:41 stanton Exp $ +# RCS: @(#) $Id: textBTree.test,v 1.4 2002/07/12 21:08:49 dgp Exp $ -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::test +eval tcltest::configure $argv catch {destroy .t} text .t diff --git a/tests/textDisp.test b/tests/textDisp.test index 840b4d6..64be19e 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -6,14 +6,19 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textDisp.test,v 1.5 2001/09/21 20:37:57 hobbs Exp $ +# RCS: @(#) $Id: textDisp.test,v 1.6 2002/07/12 21:08:49 dgp Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} -if {$::tcltest::testConfig(fonts) == 0} { - puts "skipping font-sensitive tests" -} +package require tcltest 2.1 +namespace import -force tcltest::test +namespace import -force tcltest::testsDirectory +namespace import -force tcltest::configure +namespace import -force tcltest::interpreter +namespace import -force tcltest::makeFile +namespace import -force tcltest::removeFile +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands +eval configure $argv # The procedure below is used as the scrolling command for the text; # it just saves the scrolling information in a variable "scrollInfo". diff --git a/tests/textImage.test b/tests/textImage.test index 9b17358..1698763 100644 --- a/tests/textImage.test +++ b/tests/textImage.test @@ -7,25 +7,16 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textImage.test,v 1.3 1999/04/16 01:51:41 stanton Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} - -# Test Arguments: -# name - Name of test, in the form foo-1.2. -# description - Short textual description of the test, to -# help humans understand what it does. -# constraints - A list of one or more keywords, each of -# which must be the name of an element in -# the array "::tcltest::testConfig". If any of these -# elements is zero, the test is skipped. -# This argument may be omitted. -# script - Script to run to carry out the test. It must -# return a result that can be checked for -# correctness. -# answer - Expected result from script. +# RCS: @(#) $Id: textImage.test,v 1.4 2002/07/12 21:08:49 dgp Exp $ + +package require tcltest 2.1 +namespace import -force tcltest::test +namespace import -force tcltest::testsDirectory +namespace import -force tcltest::configure +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands +eval configure $argv # One time setup. Create a font to insure the tests are font metric invariant. diff --git a/tests/textIndex.test b/tests/textIndex.test index 26dfc78..2973c8b 100644 --- a/tests/textIndex.test +++ b/tests/textIndex.test @@ -6,16 +6,20 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textIndex.test,v 1.5 1999/04/21 21:53:30 rjohnson Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} +# RCS: @(#) $Id: textIndex.test,v 1.6 2002/07/12 21:08:49 dgp Exp $ + +package require tcltest 2.1 +namespace import -force tcltest::test +namespace import -force tcltest::testConstraint +namespace import -force tcltest::testsDirectory +namespace import -force tcltest::configure +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands +eval configure $argv # Some tests require the testtext command - -set ::tcltest::testConfig(testtext) \ - [expr {[info commands testtext] != {}}] +testConstraint testtext [llength [info commands testtext]] catch {destroy .t} text .t -font {Courier -12} -width 20 -height 10 diff --git a/tests/textMark.test b/tests/textMark.test index 775c252..6eae772 100644 --- a/tests/textMark.test +++ b/tests/textMark.test @@ -6,19 +6,17 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textMark.test,v 1.3 1999/04/16 01:51:41 stanton Exp $ +# RCS: @(#) $Id: textMark.test,v 1.4 2002/07/12 21:08:49 dgp Exp $ -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::test +namespace import -force tcltest::testConstraint +eval tcltest::configure $argv catch {destroy .t} -if [catch {text .t -font {Courier 12} -width 20 -height 10}] { - puts "The font needed by these tests isn't available, so I'm" - puts "going to skip the tests." - ::tcltest::cleanupTests - return -} +testConstraint courier12 [expr {[catch { + text .t -font {Courier 12} -width 20 -height 10 + }] == 0}] pack append . .t {top expand fill} update .t debug on @@ -41,83 +39,83 @@ bOy GIrl .#@? x_yz !@#$% Line 7" -test textMark-1.1 {TkTextMarkCmd - missing option} { +test textMark-1.1 {TkTextMarkCmd - missing option} courier12 { list [catch {.t mark} msg] $msg } {1 {wrong # args: should be ".t mark option ?arg arg ...?"}} -test textMark-1.2 {TkTextMarkCmd - bogus option} { +test textMark-1.2 {TkTextMarkCmd - bogus option} courier12 { list [catch {.t mark gorp} msg] $msg } {1 {bad mark option "gorp": must be gravity, names, next, previous, set, or unset}} -test textMark-1.3 {TkTextMarkCmd - "gravity" option} { +test textMark-1.3 {TkTextMarkCmd - "gravity" option} courier12 { list [catch {.t mark gravity foo} msg] $msg } {1 {there is no mark named "foo"}} -test textMark-1.4 {TkTextMarkCmd - "gravity" option} { +test textMark-1.4 {TkTextMarkCmd - "gravity" option} courier12 { .t mark unset x .t mark set x 1.3 .t insert 1.3 x list [.t mark gravity x] [.t index x] } {right 1.4} -test textMark-1.5 {TkTextMarkCmd - "gravity" option} { +test textMark-1.5 {TkTextMarkCmd - "gravity" option} courier12 { .t mark unset x .t mark set x 1.3 .t mark g x left .t insert 1.3 x list [.t mark gravity x] [.t index x] } {left 1.3} -test textMark-1.6 {TkTextMarkCmd - "gravity" option} { +test textMark-1.6 {TkTextMarkCmd - "gravity" option} courier12 { .t mark unset x .t mark set x 1.3 .t mark gravity x right .t insert 1.3 x list [.t mark gravity x] [.t index x] } {right 1.4} -test textMark-1.7 {TkTextMarkCmd - "gravity" option} { +test textMark-1.7 {TkTextMarkCmd - "gravity" option} courier12 { list [catch {.t mark gravity x gorp} msg] $msg } {1 {bad mark gravity "gorp": must be left or right}} -test textMark-1.8 {TkTextMarkCmd - "gravity" option} { +test textMark-1.8 {TkTextMarkCmd - "gravity" option} courier12 { list [catch {.t mark gravity} msg] $msg } {1 {wrong # args: should be ".t mark gravity markName ?gravity?"}} -test textMark-2.1 {TkTextMarkCmd - "names" option} { +test textMark-2.1 {TkTextMarkCmd - "names" option} courier12 { list [catch {.t mark names 2} msg] $msg } {1 {wrong # args: should be ".t mark names"}} .t mark unset x -test textMark-2.2 {TkTextMarkCmd - "names" option} { +test textMark-2.2 {TkTextMarkCmd - "names" option} courier12 { lsort [.t mark n] } {current insert} -test textMark-2.3 {TkTextMarkCmd - "names" option} { +test textMark-2.3 {TkTextMarkCmd - "names" option} courier12 { .t mark set a 1.1 .t mark set "b c" 2.3 lsort [.t mark names] } {a {b c} current insert} -test textMark-3.1 {TkTextMarkCmd - "set" option} { +test textMark-3.1 {TkTextMarkCmd - "set" option} courier12 { list [catch {.t mark set a} msg] $msg } {1 {wrong # args: should be ".t mark set markName index"}} -test textMark-3.2 {TkTextMarkCmd - "set" option} { +test textMark-3.2 {TkTextMarkCmd - "set" option} courier12 { list [catch {.t mark s a b c} msg] $msg } {1 {wrong # args: should be ".t mark set markName index"}} -test textMark-3.3 {TkTextMarkCmd - "set" option} { +test textMark-3.3 {TkTextMarkCmd - "set" option} courier12 { list [catch {.t mark set a @x} msg] $msg } {1 {bad text index "@x"}} -test textMark-3.4 {TkTextMarkCmd - "set" option} { +test textMark-3.4 {TkTextMarkCmd - "set" option} courier12 { .t mark set a 1.2 .t index a } 1.2 -test textMark-3.5 {TkTextMarkCmd - "set" option} { +test textMark-3.5 {TkTextMarkCmd - "set" option} courier12 { .t mark set a end .t index a } {8.0} -test textMark-4.1 {TkTextMarkCmd - "unset" option} { +test textMark-4.1 {TkTextMarkCmd - "unset" option} courier12 { list [catch {.t mark unset} msg] $msg } {0 {}} -test textMark-4.2 {TkTextMarkCmd - "unset" option} { +test textMark-4.2 {TkTextMarkCmd - "unset" option} courier12 { .t mark set a 1.2 .t mark set b 2.3 .t mark unset a b list [catch {.t index a} msg] $msg [catch {.t index b} msg2] $msg2 } {1 {bad text index "a"} 1 {bad text index "b"}} -test textMark-4.3 {TkTextMarkCmd - "unset" option} { +test textMark-4.3 {TkTextMarkCmd - "unset" option} courier12 { .t mark set a 1.2 .t mark set b 2.3 .t mark set 49ers 3.1 @@ -125,14 +123,14 @@ test textMark-4.3 {TkTextMarkCmd - "unset" option} { lsort [.t mark names] } {current insert} -test textMark-5.1 {TkTextMarkCmd - miscellaneous} { +test textMark-5.1 {TkTextMarkCmd - miscellaneous} courier12 { list [catch {.t mark} msg] $msg } {1 {wrong # args: should be ".t mark option ?arg arg ...?"}} -test textMark-5.2 {TkTextMarkCmd - miscellaneous} { +test textMark-5.2 {TkTextMarkCmd - miscellaneous} courier12 { list [catch {.t mark foo} msg] $msg } {1 {bad mark option "foo": must be gravity, names, next, previous, set, or unset}} -test textMark-6.1 {TkTextMarkSegToIndex} { +test textMark-6.1 {TkTextMarkSegToIndex} courier12 { .t mark set a 1.2 .t mark set b 1.2 .t mark set c 1.2 @@ -141,79 +139,79 @@ test textMark-6.1 {TkTextMarkSegToIndex} { } {1.2 1.2 1.2 1.4} catch {eval {.t mark unset} [.t mark names]} -test textMark-7.1 {MarkFindNext - invalid mark name} { +test textMark-7.1 {MarkFindNext - invalid mark name} courier12 { catch {.t mark next bogus} x set x } {bad text index "bogus"} -test textMark-7.2 {MarkFindNext - marks at same location} { +test textMark-7.2 {MarkFindNext - marks at same location} courier12 { .t mark set insert 2.0 .t mark set current 2.0 .t mark next current } {insert} -test textMark-7.3 {MarkFindNext - numerical starting mark} { +test textMark-7.3 {MarkFindNext - numerical starting mark} courier12 { .t mark set current 1.0 .t mark set insert 1.0 .t mark next 1.0 } {insert} -test textMark-7.4 {MarkFindNext - mark on the same line} { +test textMark-7.4 {MarkFindNext - mark on the same line} courier12 { .t mark set current 1.0 .t mark set insert 1.1 .t mark next current } {insert} -test textMark-7.5 {MarkFindNext - mark on the next line} { +test textMark-7.5 {MarkFindNext - mark on the next line} courier12 { .t mark set current 1.end .t mark set insert 2.0 .t mark next current } {insert} -test textMark-7.6 {MarkFindNext - mark far away} { +test textMark-7.6 {MarkFindNext - mark far away} courier12 { .t mark set current 1.2 .t mark set insert 7.0 .t mark next current } {insert} -test textMark-7.7 {MarkFindNext - mark on top of end} { +test textMark-7.7 {MarkFindNext - mark on top of end} courier12 { .t mark set current end .t mark next end } {current} -test textMark-7.8 {MarkFindNext - no next mark} { +test textMark-7.8 {MarkFindNext - no next mark} courier12 { .t mark set current 1.0 .t mark set insert 3.0 .t mark next insert } {} -test textMark-8.1 {MarkFindPrev - invalid mark name} { +test textMark-8.1 {MarkFindPrev - invalid mark name} courier12 { catch {.t mark prev bogus} x set x } {bad text index "bogus"} -test textMark-8.2 {MarkFindPrev - marks at same location} { +test textMark-8.2 {MarkFindPrev - marks at same location} courier12 { .t mark set insert 2.0 .t mark set current 2.0 .t mark prev insert } {current} -test textMark-8.3 {MarkFindPrev - numerical starting mark} { +test textMark-8.3 {MarkFindPrev - numerical starting mark} courier12 { .t mark set current 1.0 .t mark set insert 1.0 .t mark prev 1.1 } {current} -test textMark-8.4 {MarkFindPrev - mark on the same line} { +test textMark-8.4 {MarkFindPrev - mark on the same line} courier12 { .t mark set current 1.0 .t mark set insert 1.1 .t mark prev insert } {current} -test textMark-8.5 {MarkFindPrev - mark on the previous line} { +test textMark-8.5 {MarkFindPrev - mark on the previous line} courier12 { .t mark set current 1.end .t mark set insert 2.0 .t mark prev insert } {current} -test textMark-8.6 {MarkFindPrev - mark far away} { +test textMark-8.6 {MarkFindPrev - mark far away} courier12 { .t mark set current 1.2 .t mark set insert 7.0 .t mark prev insert } {current} -test textMark-8.7 {MarkFindPrev - mark on top of end} { +test textMark-8.7 {MarkFindPrev - mark on top of end} courier12 { .t mark set insert 3.0 .t mark set current end .t mark prev end } {insert} -test textMark-8.8 {MarkFindPrev - no previous mark} { +test textMark-8.8 {MarkFindPrev - no previous mark} courier12 { .t mark set current 1.0 .t mark set insert 3.0 .t mark prev current diff --git a/tests/textTag.test b/tests/textTag.test index 7bc04fd..d0797f5 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -6,19 +6,18 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textTag.test,v 1.4 1999/12/14 06:53:14 hobbs Exp $ +# RCS: @(#) $Id: textTag.test,v 1.5 2002/07/12 21:08:49 dgp Exp $ -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::test +namespace import -force tcltest::testConstraint +eval tcltest::configure $argv catch {destroy .t} -if [catch {text .t -font {Courier 12} -width 20 -height 10}] { - puts "The font needed by these tests isn't available, so I'm" - puts "going to skip the tests." - ::tcltest::cleanupTests - return -} +testConstraint courier12 [expr {[catch { + text .t -font {Courier 12} -width 20 -height 10 + }] == 0}] + pack append . .t {top expand fill} update .t debug on @@ -85,219 +84,219 @@ foreach test { {expected boolean value but got "stupid"}} } { set name [lindex $test 0] - test textTag-1.$i {tag configuration options} { + test textTag-1.$i {tag configuration options} courier12 { .t tag configure x $name [lindex $test 1] .t tag cget x $name } [lindex $test 2] incr i if {[lindex $test 3] != ""} { - test textTag-1.$i {configuration options} { + test textTag-1.$i {configuration options} courier12 { list [catch {.t tag configure x $name [lindex $test 3]} msg] $msg } [list 1 [lindex $test 4]] } .t tag configure x $name [lindex [.t tag configure x $name] 3] incr i } -test textTag-2.1 {TkTextTagCmd - "add" option} { +test textTag-2.1 {TkTextTagCmd - "add" option} courier12 { list [catch {.t tag} msg] $msg } {1 {wrong # args: should be ".t tag option ?arg arg ...?"}} -test textTag-2.2 {TkTextTagCmd - "add" option} { +test textTag-2.2 {TkTextTagCmd - "add" option} courier12 { list [catch {.t tag gorp} msg] $msg } {1 {bad tag option "gorp": must be add, bind, cget, configure, delete, lower, names, nextrange, raise, ranges, or remove}} -test textTag-2.3 {TkTextTagCmd - "add" option} { +test textTag-2.3 {TkTextTagCmd - "add" option} courier12 { list [catch {.t tag add foo} msg] $msg } {1 {wrong # args: should be ".t tag add tagName index1 ?index2 index1 index2 ...?"}} -test textTag-2.4 {TkTextTagCmd - "add" option} { +test textTag-2.4 {TkTextTagCmd - "add" option} courier12 { list [catch {.t tag add x gorp} msg] $msg } {1 {bad text index "gorp"}} -test textTag-2.5 {TkTextTagCmd - "add" option} { +test textTag-2.5 {TkTextTagCmd - "add" option} courier12 { list [catch {.t tag add x 1.2 gorp} msg] $msg } {1 {bad text index "gorp"}} -test textTag-2.6 {TkTextTagCmd - "add" option} { +test textTag-2.6 {TkTextTagCmd - "add" option} courier12 { .t tag add sel 3.2 3.4 .t tag add sel 3.2 3.0 .t tag ranges sel } {3.2 3.4} -test textTag-2.7 {TkTextTagCmd - "add" option} { +test textTag-2.7 {TkTextTagCmd - "add" option} courier12 { .t tag add x 1.0 1.end .t tag ranges x } {1.0 1.6} -test textTag-2.8 {TkTextTagCmd - "add" option} { +test textTag-2.8 {TkTextTagCmd - "add" option} courier12 { .t tag remove x 1.0 end .t tag add x 1.2 .t tag ranges x } {1.2 1.3} -test textTag-2.9 {TkTextTagCmd - "add" option} { +test textTag-2.9 {TkTextTagCmd - "add" option} courier12 { .t.e select from 0 .t.e select to 4 .t tag add sel 3.2 3.4 selection get } 34 -test textTag-2.11 {TkTextTagCmd - "add" option} { +test textTag-2.11 {TkTextTagCmd - "add" option} courier12 { .t.e select from 0 .t.e select to 4 .t configure -exportselection 0 .t tag add sel 3.2 3.4 selection get } Text -test textTag-2.12 {TkTextTagCmd - "add" option} { +test textTag-2.12 {TkTextTagCmd - "add" option} courier12 { .t tag remove sel 1.0 end .t tag add sel 1.1 1.5 2.4 3.1 4.2 4.4 .t tag ranges sel } {1.1 1.5 2.4 3.1 4.2 4.4} -test textTag-2.13 {TkTextTagCmd - "add" option} { +test textTag-2.13 {TkTextTagCmd - "add" option} courier12 { .t tag remove sel 1.0 end .t tag add sel 1.1 1.5 2.4 .t tag ranges sel } {1.1 1.5 2.4 2.5} catch {.t tag delete x} -test textTag-3.1 {TkTextTagCmd - "bind" option} { +test textTag-3.1 {TkTextTagCmd - "bind" option} courier12 { list [catch {.t tag bind} msg] $msg } {1 {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}} -test textTag-3.2 {TkTextTagCmd - "bind" option} { +test textTag-3.2 {TkTextTagCmd - "bind" option} courier12 { list [catch {.t tag bind 1 2 3 4} msg] $msg } {1 {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}} -test textTag-3.3 {TkTextTagCmd - "bind" option} { +test textTag-3.3 {TkTextTagCmd - "bind" option} courier12 { .t tag bind x script1 .t tag bind x } script1 -test textTag-3.4 {TkTextTagCmd - "bind" option} { +test textTag-3.4 {TkTextTagCmd - "bind" option} courier12 { list [catch {.t tag bind x script2} msg] $msg } {1 {bad event type or keysym "Gorp"}} -test textTag-3.5 {TkTextTagCmd - "bind" option} { +test textTag-3.5 {TkTextTagCmd - "bind" option} courier12 { .t tag delete x .t tag bind x script1 list [catch {.t tag bind x script2} msg] $msg [.t tag bind x] } {1 {requested illegal events; only key, button, motion, enter, leave, and virtual events may be used} } -test textTag-3.6 {TkTextTagCmd - "bind" option} { +test textTag-3.6 {TkTextTagCmd - "bind" option} courier12 { .t tag delete x .t tag bind x script1 .t tag bind x script2 .t tag bind x a xyzzy list [lsort [.t tag bind x]] [.t tag bind x ] [.t tag bind x a] } {{ a} script1 xyzzy} -test textTag-3.7 {TkTextTagCmd - "bind" option} { +test textTag-3.7 {TkTextTagCmd - "bind" option} courier12 { .t tag delete x .t tag bind x script1 .t tag bind x +script2 .t tag bind x } {script1 script2} -test textTag-3.7 {TkTextTagCmd - "bind" option} { +test textTag-3.7 {TkTextTagCmd - "bind" option} courier12 { .t tag delete x list [catch {.t tag bind x } msg] $msg } {0 {}} -test textTag-3.8 {TkTextTagCmd - "bind" option} { +test textTag-3.8 {TkTextTagCmd - "bind" option} courier12 { .t tag delete x list [catch {.t tag bind x <} msg] $msg } {1 {no event type or button # or keysym}} -test textTag-4.1 {TkTextTagCmd - "cget" option} { +test textTag-4.1 {TkTextTagCmd - "cget" option} courier12 { list [catch {.t tag cget a} msg] $msg } {1 {wrong # args: should be ".t tag cget tagName option"}} -test textTag-4.2 {TkTextTagCmd - "cget" option} { +test textTag-4.2 {TkTextTagCmd - "cget" option} courier12 { list [catch {.t tag cget a b c} msg] $msg } {1 {wrong # args: should be ".t tag cget tagName option"}} -test textTag-4.3 {TkTextTagCmd - "cget" option} { +test textTag-4.3 {TkTextTagCmd - "cget" option} courier12 { .t tag delete foo list [catch {.t tag cget foo bar} msg] $msg } {1 {tag "foo" isn't defined in text widget}} -test textTag-4.4 {TkTextTagCmd - "cget" option} { +test textTag-4.4 {TkTextTagCmd - "cget" option} courier12 { list [catch {.t tag cget sel bogus} msg] $msg } {1 {unknown option "bogus"}} -test textTag-4.5 {TkTextTagCmd - "cget" option} { +test textTag-4.5 {TkTextTagCmd - "cget" option} courier12 { .t tag delete x .t tag configure x -background red list [catch {.t tag cget x -background} msg] $msg } {0 red} -test textTag-5.1 {TkTextTagCmd - "configure" option} { +test textTag-5.1 {TkTextTagCmd - "configure" option} courier12 { list [catch {.t tag configure} msg] $msg } {1 {wrong # args: should be ".t tag configure tagName ?option? ?value? ?option value ...?"}} -test textTag-5.2 {TkTextTagCmd - "configure" option} { +test textTag-5.2 {TkTextTagCmd - "configure" option} courier12 { list [catch {.t tag configure x -foo} msg] $msg } {1 {unknown option "-foo"}} -test textTag-5.3 {TkTextTagCmd - "configure" option} { +test textTag-5.3 {TkTextTagCmd - "configure" option} courier12 { list [catch {.t tag configure x -background red -underline} msg] $msg } {1 {value for "-underline" missing}} -test textTag-5.4 {TkTextTagCmd - "configure" option} { +test textTag-5.4 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x .t tag configure x -underline yes .t tag configure x -underline } {-underline {} {} {} yes} -test textTag-5.5 {TkTextTagCmd - "configure" option} { +test textTag-5.5 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x .t tag configure x -overstrike on .t tag cget x -overstrike } {on} -test textTag-5.6 {TkTextTagCmd - "configure" option} { +test textTag-5.6 {TkTextTagCmd - "configure" option} courier12 { list [catch {.t tag configure x -overstrike foo} msg] $msg } {1 {expected boolean value but got "foo"}} -test textTag-5.7 {TkTextTagCmd - "configure" option} { +test textTag-5.7 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x list [catch {.t tag configure x -underline stupid} msg] $msg } {1 {expected boolean value but got "stupid"}} -test textTag-5.8 {TkTextTagCmd - "configure" option} { +test textTag-5.8 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x .t tag configure x -justify left .t tag configure x -justify } {-justify {} {} {} left} -test textTag-5.9 {TkTextTagCmd - "configure" option} { +test textTag-5.9 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x list [catch {.t tag configure x -justify bogus} msg] $msg } {1 {bad justification "bogus": must be left, right, or center}} -test textTag-5.10 {TkTextTagCmd - "configure" option} { +test textTag-5.10 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x list [catch {.t tag configure x -justify fill} msg] $msg } {1 {bad justification "fill": must be left, right, or center}} -test textTag-5.11 {TkTextTagCmd - "configure" option} { +test textTag-5.11 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x .t tag configure x -offset 2 .t tag configure x -offset } {-offset {} {} {} 2} -test textTag-5.12 {TkTextTagCmd - "configure" option} { +test textTag-5.12 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x list [catch {.t tag configure x -offset 1.0q} msg] $msg } {1 {bad screen distance "1.0q"}} -test textTag-5.13 {TkTextTagCmd - "configure" option} { +test textTag-5.13 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x .t tag configure x -lmargin1 2 -lmargin2 4 -rmargin 5 list [.t tag configure x -lmargin1] [.t tag configure x -lmargin2] \ [.t tag configure x -rmargin] } {{-lmargin1 {} {} {} 2} {-lmargin2 {} {} {} 4} {-rmargin {} {} {} 5}} -test textTag-5.14 {TkTextTagCmd - "configure" option} { +test textTag-5.14 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x list [catch {.t tag configure x -lmargin1 2.0x} msg] $msg } {1 {bad screen distance "2.0x"}} -test textTag-5.15 {TkTextTagCmd - "configure" option} { +test textTag-5.15 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x list [catch {.t tag configure x -lmargin2 gorp} msg] $msg } {1 {bad screen distance "gorp"}} -test textTag-5.16 {TkTextTagCmd - "configure" option} { +test textTag-5.16 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x list [catch {.t tag configure x -rmargin 140.1.1} msg] $msg } {1 {bad screen distance "140.1.1"}} .t tag delete x -test textTag-5.17 {TkTextTagCmd - "configure" option} { +test textTag-5.17 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x .t tag configure x -spacing1 2 -spacing2 4 -spacing3 6 list [.t tag configure x -spacing1] [.t tag configure x -spacing2] \ [.t tag configure x -spacing3] } {{-spacing1 {} {} {} 2} {-spacing2 {} {} {} 4} {-spacing3 {} {} {} 6}} -test textTag-5.18 {TkTextTagCmd - "configure" option} { +test textTag-5.18 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x list [catch {.t tag configure x -spacing1 2.0x} msg] $msg } {1 {bad screen distance "2.0x"}} -test textTag-5.19 {TkTextTagCmd - "configure" option} { +test textTag-5.19 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x list [catch {.t tag configure x -spacing1 lousy} msg] $msg } {1 {bad screen distance "lousy"}} -test textTag-5.20 {TkTextTagCmd - "configure" option} { +test textTag-5.20 {TkTextTagCmd - "configure" option} courier12 { .t tag delete x list [catch {.t tag configure x -spacing1 4.2.3} msg] $msg } {1 {bad screen distance "4.2.3"}} -test textTag-5.21 {TkTextTagCmd - "configure" option} { +test textTag-5.21 {TkTextTagCmd - "configure" option} courier12 { .t configure -selectborderwidth 2 -selectforeground blue \ -selectbackground black .t tag configure sel -borderwidth 4 -foreground green -background yellow @@ -307,19 +306,19 @@ test textTag-5.21 {TkTextTagCmd - "configure" option} { } set x } {4 green yellow} -test textTag-5.22 {TkTextTagCmd - "configure" option} { +test textTag-5.22 {TkTextTagCmd - "configure" option} courier12 { .t configure -selectborderwidth 20 .t tag configure sel -borderwidth {} .t cget -selectborderwidth } {} -test textTag-6.1 {TkTextTagCmd - "delete" option} { +test textTag-6.1 {TkTextTagCmd - "delete" option} courier12 { list [catch {.t tag delete} msg] $msg } {1 {wrong # args: should be ".t tag delete tagName tagName ..."}} -test textTag-6.2 {TkTextTagCmd - "delete" option} { +test textTag-6.2 {TkTextTagCmd - "delete" option} courier12 { list [catch {.t tag delete zork} msg] $msg } {0 {}} -test textTag-6.3 {TkTextTagCmd - "delete" option} { +test textTag-6.3 {TkTextTagCmd - "delete" option} courier12 { .t tag delete x .t tag config x -background black .t tag config y -foreground white @@ -327,14 +326,14 @@ test textTag-6.3 {TkTextTagCmd - "delete" option} { .t tag delete y z lsort [.t tag names] } {sel x} -test textTag-6.4 {TkTextTagCmd - "delete" option} { +test textTag-6.4 {TkTextTagCmd - "delete" option} courier12 { .t tag config x -background black .t tag config y -foreground white .t tag config z -background black eval .t tag delete [.t tag names] .t tag names } {sel} -test textTag-6.5 {TkTextTagCmd - "delete" option} { +test textTag-6.5 {TkTextTagCmd - "delete" option} courier12 { .t tag bind x foo .t tag delete x .t tag configure x -background black @@ -348,39 +347,39 @@ proc tagsetup {} { .t tag configure $i -background black } } -test textTag-7.1 {TkTextTagCmd - "lower" option} { +test textTag-7.1 {TkTextTagCmd - "lower" option} courier12 { list [catch {.t tag lower} msg] $msg } {1 {wrong # args: should be ".t tag lower tagName ?belowThis?"}} -test textTag-7.2 {TkTextTagCmd - "lower" option} { +test textTag-7.2 {TkTextTagCmd - "lower" option} courier12 { list [catch {.t tag lower foo} msg] $msg } {1 {tag "foo" isn't defined in text widget}} -test textTag-7.3 {TkTextTagCmd - "lower" option} { +test textTag-7.3 {TkTextTagCmd - "lower" option} courier12 { list [catch {.t tag lower sel bar} msg] $msg } {1 {tag "bar" isn't defined in text widget}} -test textTag-7.4 {TkTextTagCmd - "lower" option} { +test textTag-7.4 {TkTextTagCmd - "lower" option} courier12 { tagsetup .t tag lower c .t tag names } {c sel a b d} -test textTag-7.5 {TkTextTagCmd - "lower" option} { +test textTag-7.5 {TkTextTagCmd - "lower" option} courier12 { tagsetup .t tag lower d b .t tag names } {sel a d b c} -test textTag-7.6 {TkTextTagCmd - "lower" option} { +test textTag-7.6 {TkTextTagCmd - "lower" option} courier12 { tagsetup .t tag lower a c .t tag names } {sel b a c d} -test textTag-8.1 {TkTextTagCmd - "names" option} { +test textTag-8.1 {TkTextTagCmd - "names" option} courier12 { list [catch {.t tag names a b} msg] $msg } {1 {wrong # args: should be ".t tag names ?index?"}} -test textTag-8.2 {TkTextTagCmd - "names" option} { +test textTag-8.2 {TkTextTagCmd - "names" option} courier12 { tagsetup .t tag names } {sel a b c d} -test textTag-8.3 {TkTextTagCmd - "names" option} { +test textTag-8.3 {TkTextTagCmd - "names" option} courier12 { tagsetup .t tag add "a b" 2.1 2.6 .t tag add c 2.4 2.7 @@ -391,148 +390,148 @@ test textTag-8.3 {TkTextTagCmd - "names" option} { .t tag add x 2.3 2.5 .t tag add x 2.9 3.1 .t tag add x 7.2 -test textTag-9.1 {TkTextTagCmd - "nextrange" option} { +test textTag-9.1 {TkTextTagCmd - "nextrange" option} courier12 { list [catch {.t tag nextrange x} msg] $msg } {1 {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}} -test textTag-9.2 {TkTextTagCmd - "nextrange" option} { +test textTag-9.2 {TkTextTagCmd - "nextrange" option} courier12 { list [catch {.t tag nextrange x 1 2 3} msg] $msg } {1 {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}} -test textTag-9.3 {TkTextTagCmd - "nextrange" option} { +test textTag-9.3 {TkTextTagCmd - "nextrange" option} courier12 { list [catch {.t tag nextrange foo 1.0} msg] $msg } {0 {}} -test textTag-9.4 {TkTextTagCmd - "nextrange" option} { +test textTag-9.4 {TkTextTagCmd - "nextrange" option} courier12 { list [catch {.t tag nextrange x foo} msg] $msg } {1 {bad text index "foo"}} -test textTag-9.5 {TkTextTagCmd - "nextrange" option} { +test textTag-9.5 {TkTextTagCmd - "nextrange" option} courier12 { list [catch {.t tag nextrange x 1.0 bar} msg] $msg } {1 {bad text index "bar"}} -test textTag-9.6 {TkTextTagCmd - "nextrange" option} { +test textTag-9.6 {TkTextTagCmd - "nextrange" option} courier12 { .t tag nextrange x 1.0 } {2.3 2.5} -test textTag-9.7 {TkTextTagCmd - "nextrange" option} { +test textTag-9.7 {TkTextTagCmd - "nextrange" option} courier12 { .t tag nextrange x 2.2 } {2.3 2.5} -test textTag-9.8 {TkTextTagCmd - "nextrange" option} { +test textTag-9.8 {TkTextTagCmd - "nextrange" option} courier12 { .t tag nextrange x 2.3 } {2.3 2.5} -test textTag-9.9 {TkTextTagCmd - "nextrange" option} { +test textTag-9.9 {TkTextTagCmd - "nextrange" option} courier12 { .t tag nextrange x 2.4 } {2.9 3.1} -test textTag-9.10 {TkTextTagCmd - "nextrange" option} { +test textTag-9.10 {TkTextTagCmd - "nextrange" option} courier12 { .t tag nextrange x 2.4 2.9 } {} -test textTag-9.11 {TkTextTagCmd - "nextrange" option} { +test textTag-9.11 {TkTextTagCmd - "nextrange" option} courier12 { .t tag nextrange x 2.4 2.10 } {2.9 3.1} -test textTag-9.12 {TkTextTagCmd - "nextrange" option} { +test textTag-9.12 {TkTextTagCmd - "nextrange" option} courier12 { .t tag nextrange x 2.4 2.11 } {2.9 3.1} -test textTag-9.13 {TkTextTagCmd - "nextrange" option} { +test textTag-9.13 {TkTextTagCmd - "nextrange" option} courier12 { .t tag nextrange x 7.0 } {7.2 7.3} -test textTag-9.14 {TkTextTagCmd - "nextrange" option} { +test textTag-9.14 {TkTextTagCmd - "nextrange" option} courier12 { .t tag nextrange x 7.3 } {} -test textTag-10.1 {TkTextTagCmd - "prevrange" option} { +test textTag-10.1 {TkTextTagCmd - "prevrange" option} courier12 { list [catch {.t tag prevrange x} msg] $msg } {1 {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}} -test textTag-10.2 {TkTextTagCmd - "prevrange" option} { +test textTag-10.2 {TkTextTagCmd - "prevrange" option} courier12 { list [catch {.t tag prevrange x 1 2 3} msg] $msg } {1 {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}} -test textTag-10.3 {TkTextTagCmd - "prevrange" option} { +test textTag-10.3 {TkTextTagCmd - "prevrange" option} courier12 { list [catch {.t tag prevrange foo end} msg] $msg } {0 {}} -test textTag-10.4 {TkTextTagCmd - "prevrange" option} { +test textTag-10.4 {TkTextTagCmd - "prevrange" option} courier12 { list [catch {.t tag prevrange x foo} msg] $msg } {1 {bad text index "foo"}} -test textTag-10.5 {TkTextTagCmd - "prevrange" option} { +test textTag-10.5 {TkTextTagCmd - "prevrange" option} courier12 { list [catch {.t tag prevrange x end bar} msg] $msg } {1 {bad text index "bar"}} -test textTag-10.6 {TkTextTagCmd - "prevrange" option} { +test textTag-10.6 {TkTextTagCmd - "prevrange" option} courier12 { .t tag prevrange x end } {7.2 7.3} -test textTag-10.7 {TkTextTagCmd - "prevrange" option} { +test textTag-10.7 {TkTextTagCmd - "prevrange" option} courier12 { .t tag prevrange x 2.4 } {2.3 2.5} -test textTag-10.8 {TkTextTagCmd - "prevrange" option} { +test textTag-10.8 {TkTextTagCmd - "prevrange" option} courier12 { .t tag prevrange x 2.5 } {2.3 2.5} -test textTag-10.9 {TkTextTagCmd - "prevrange" option} { +test textTag-10.9 {TkTextTagCmd - "prevrange" option} courier12 { .t tag prevrange x 2.9 } {2.3 2.5} -test textTag-10.10 {TkTextTagCmd - "prevrange" option} { +test textTag-10.10 {TkTextTagCmd - "prevrange" option} courier12 { .t tag prevrange x 2.9 2.6 } {} -test textTag-10.11 {TkTextTagCmd - "prevrange" option} { +test textTag-10.11 {TkTextTagCmd - "prevrange" option} courier12 { .t tag prevrange x 2.9 2.5 } {} -test textTag-10.12 {TkTextTagCmd - "prevrange" option} { +test textTag-10.12 {TkTextTagCmd - "prevrange" option} courier12 { .t tag prevrange x 2.9 2.3 } {2.3 2.5} -test textTag-10.13 {TkTextTagCmd - "prevrange" option} { +test textTag-10.13 {TkTextTagCmd - "prevrange" option} courier12 { .t tag prevrange x 7.0 } {2.9 3.1} -test textTag-10.14 {TkTextTagCmd - "prevrange" option} { +test textTag-10.14 {TkTextTagCmd - "prevrange" option} courier12 { .t tag prevrange x 2.3 } {} -test textTag-11.1 {TkTextTagCmd - "raise" option} { +test textTag-11.1 {TkTextTagCmd - "raise" option} courier12 { list [catch {.t tag raise} msg] $msg } {1 {wrong # args: should be ".t tag raise tagName ?aboveThis?"}} -test textTag-11.2 {TkTextTagCmd - "raise" option} { +test textTag-11.2 {TkTextTagCmd - "raise" option} courier12 { list [catch {.t tag raise foo} msg] $msg } {1 {tag "foo" isn't defined in text widget}} -test textTag-11.3 {TkTextTagCmd - "raise" option} { +test textTag-11.3 {TkTextTagCmd - "raise" option} courier12 { list [catch {.t tag raise sel bar} msg] $msg } {1 {tag "bar" isn't defined in text widget}} -test textTag-11.4 {TkTextTagCmd - "raise" option} { +test textTag-11.4 {TkTextTagCmd - "raise" option} courier12 { tagsetup .t tag raise c .t tag names } {sel a b d c} -test textTag-11.5 {TkTextTagCmd - "raise" option} { +test textTag-11.5 {TkTextTagCmd - "raise" option} courier12 { tagsetup .t tag raise d b .t tag names } {sel a b d c} -test textTag-11.6 {TkTextTagCmd - "raise" option} { +test textTag-11.6 {TkTextTagCmd - "raise" option} courier12 { tagsetup .t tag raise a c .t tag names } {sel b c a d} -test textTag-12.1 {TkTextTagCmd - "ranges" option} { +test textTag-12.1 {TkTextTagCmd - "ranges" option} courier12 { list [catch {.t tag ranges} msg] $msg } {1 {wrong # args: should be ".t tag ranges tagName"}} -test textTag-12.2 {TkTextTagCmd - "ranges" option} { +test textTag-12.2 {TkTextTagCmd - "ranges" option} courier12 { .t tag delete x .t tag ranges x } {} -test textTag-12.3 {TkTextTagCmd - "ranges" option} { +test textTag-12.3 {TkTextTagCmd - "ranges" option} courier12 { .t tag delete x .t tag add x 2.2 .t tag add x 2.7 4.15 .t tag add x 5.2 5.5 .t tag ranges x } {2.2 2.3 2.7 4.6 5.2 5.5} -test textTag-12.4 {TkTextTagCmd - "ranges" option} { +test textTag-12.4 {TkTextTagCmd - "ranges" option} courier12 { .t tag delete x .t tag add x 1.0 3.0 .t tag add x 4.0 end .t tag ranges x } {1.0 3.0 4.0 8.0} -test textTag-13.1 {TkTextTagCmd - "remove" option} { +test textTag-13.1 {TkTextTagCmd - "remove" option} courier12 { list [catch {.t tag remove} msg] $msg } {1 {wrong # args: should be ".t tag remove tagName index1 ?index2 index1 index2 ...?"}} -test textTag-13.2 {TkTextTagCmd - "remove" option} { +test textTag-13.2 {TkTextTagCmd - "remove" option} courier12 { .t tag delete x .t tag add x 2.2 2.11 .t tag remove x 2.3 2.7 .t tag ranges x } {2.2 2.3 2.7 2.11} -test textTag-13.3 {TkTextTagCmd - "remove" option} { +test textTag-13.3 {TkTextTagCmd - "remove" option} courier12 { .t configure -exportselection 1 .t tag remove sel 1.0 end .t tag add sel 2.4 3.3 @@ -542,14 +541,14 @@ test textTag-13.3 {TkTextTagCmd - "remove" option} { } Text .t tag delete x a b c d -test textTag-14.1 {SortTags} { +test textTag-14.1 {SortTags} courier12 { foreach i {a b c d} { .t tag add $i 2.0 2.2 } .t tag names 2.1 } {a b c d} .t tag delete a b c d -test textTag-14.2 {SortTags} { +test textTag-14.2 {SortTags} courier12 { foreach i {a b c d} { .t tag configure $i -background black } @@ -559,13 +558,13 @@ test textTag-14.2 {SortTags} { .t tag names 2.1 } {a b c d} .t tag delete x a b c d -test textTag-14.3 {SortTags} { +test textTag-14.3 {SortTags} courier12 { for {set i 0} {$i < 30} {incr i} { .t tag add x$i 2.0 2.2 } .t tag names 2.1 } {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29} -test textTag-14.4 {SortTags} { +test textTag-14.4 {SortTags} courier12 { for {set i 0} {$i < 30} {incr i} { .t tag configure x$i -background black } @@ -588,7 +587,7 @@ set c [.t bbox 4.3] set x3 [expr [lindex $c 0] + [lindex $c 2]/2] set y3 [expr [lindex $c 1] + [lindex $c 3]/2] -test textTag-15.1 {TkTextBindProc} { +test textTag-15.1 {TkTextBindProc} courier12 { bind .t {lappend x up} .t tag bind x {lappend x x-up} .t tag bind y {lappend x y-up} @@ -607,7 +606,7 @@ test textTag-15.1 {TkTextBindProc} { bind .t {} set x } {x-up up up y-up up} -test textTag-15.2 {TkTextBindProc} { +test textTag-15.2 {TkTextBindProc} courier12 { catch {.t tag delete x} catch {.t tag delete y} .t tag bind x {lappend x x-enter} @@ -631,7 +630,7 @@ test textTag-15.2 {TkTextBindProc} { event gen .t -x $x3 -y $y3 set x } {x-enter | x-down | | x-up x-leave y-enter} -test textTag-15.3 {TkTextBindProc} { +test textTag-15.3 {TkTextBindProc} courier12 { catch {.t tag delete x} catch {.t tag delete y} .t tag bind x {lappend x x-enter} @@ -664,7 +663,7 @@ foreach tag [.t tag names] { catch {.t tag delete $tag} } .t tag configure big -font $bigFont -test textTag-16.1 {TkTextPickCurrent procedure} { +test textTag-16.1 {TkTextPickCurrent procedure} courier12 { event gen .t -state 0x100 -x $x1 -y $y1 set x [.t index current] event gen .t -x $x2 -y $y2 @@ -680,7 +679,7 @@ test textTag-16.1 {TkTextPickCurrent procedure} { event gen .t -state 0x100 -x $x3 -y $y3 lappend x [.t index current] } {2.1 3.2 3.2 3.2 3.2 3.2 4.3} -test textTag-16.2 {TkTextPickCurrent procedure} { +test textTag-16.2 {TkTextPickCurrent procedure} courier12 { event gen .t -state 0x100 -x $x1 -y $y1 event gen .t -x $x2 -y $y2 set x [.t index current] @@ -693,7 +692,7 @@ foreach i {a b c d} { .t tag bind $i "lappend x enter-$i" .t tag bind $i "lappend x leave-$i" } -test textTag-16.3 {TkTextPickCurrent procedure} { +test textTag-16.3 {TkTextPickCurrent procedure} courier12 { foreach i {a b c d} { .t tag remove $i 1.0 end } @@ -711,7 +710,7 @@ test textTag-16.3 {TkTextPickCurrent procedure} { event gen .t -x $x3 -y $y3 set x } {enter-a enter-b | leave-b enter-c | leave-a leave-c} -test textTag-16.4 {TkTextPickCurrent procedure} { +test textTag-16.4 {TkTextPickCurrent procedure} courier12 { foreach i {a b c d} { .t tag remove $i 1.0 end } @@ -731,7 +730,7 @@ test textTag-16.4 {TkTextPickCurrent procedure} { foreach i {a b c d} { .t tag delete $i } -test textTag-16.5 {TkTextPickCurrent procedure} { +test textTag-16.5 {TkTextPickCurrent procedure} courier12 { foreach i {a b c d} { .t tag remove $i 1.0 end } @@ -741,7 +740,7 @@ test textTag-16.5 {TkTextPickCurrent procedure} { event gen .t -x $x2 -y $y2 .t index current } {3.2} -test textTag-16.6 {TkTextPickCurrent procedure} { +test textTag-16.6 {TkTextPickCurrent procedure} courier12 { foreach i {a b c d} { .t tag remove $i 1.0 end } @@ -752,7 +751,7 @@ test textTag-16.6 {TkTextPickCurrent procedure} { update .t index current } {3.1} -test textTag-16.7 {TkTextPickCurrent procedure} { +test textTag-16.7 {TkTextPickCurrent procedure} courier12 { foreach i {a b c d} { .t tag remove $i 1.0 end } diff --git a/tests/textWind.test b/tests/textWind.test index 4e11955..43aefff 100644 --- a/tests/textWind.test +++ b/tests/textWind.test @@ -6,11 +6,16 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textWind.test,v 1.3 1999/04/16 01:51:41 stanton Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} +# RCS: @(#) $Id: textWind.test,v 1.4 2002/07/12 21:08:49 dgp Exp $ + +package require tcltest 2.1 +namespace import -force tcltest::test +namespace import -force tcltest::testsDirectory +namespace import -force tcltest::configure +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands +eval configure $argv foreach i [winfo child .] { catch {destroy $i} diff --git a/tests/tk.test b/tests/tk.test index d9e8baa..9423f15 100644 --- a/tests/tk.test +++ b/tests/tk.test @@ -5,11 +5,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2002 ActiveState Corporation. # -# RCS: @(#) $Id: tk.test,v 1.6 2002/06/17 20:09:01 hobbs Exp $ +# RCS: @(#) $Id: tk.test,v 1.7 2002/07/12 21:08:49 dgp Exp $ -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::test +eval tcltest::configure $argv test tk-1.1 {tk command: general} { list [catch {tk} msg] $msg diff --git a/tests/unixWm.test b/tests/unixWm.test index ddd641b..1896e75 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -7,24 +7,20 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: unixWm.test,v 1.20 2002/07/12 13:41:00 dgp Exp $ +# RCS: @(#) $Id: unixWm.test,v 1.21 2002/07/12 21:08:49 dgp Exp $ package require tcltest 2.1 namespace import -force tcltest::test namespace import -force tcltest::testsDirectory namespace import -force tcltest::configure namespace import -force tcltest::interpreter +namespace import -force tcltest::makeFile +namespace import -force tcltest::removeFile configure -testdir [file join [pwd] [file dirname [info script]]] configure -loadfile [file join [testsDirectory] constraints.tcl] tcltest::loadTestedCommands eval configure $argv -if {$tcl_platform(platform) != "unix"} { - puts "skipping: Unix only tests..." - ::tcltest::cleanupTests - return -} - proc sleep ms { global x after $ms {set x 1} @@ -47,7 +43,7 @@ proc makeToplevels {} { set i 1 foreach geom {+20+80 +80+20 +0+0} { catch {destroy .t} - test unixWm-1.$i {initial window position} { + test unixWm-1.$i {initial window position} unix { toplevel .t -width 200 -height 150 wm geom .t $geom update @@ -72,7 +68,7 @@ scan [wm geom .t] %dx%d+%d+%d width height x y set xerr [expr 150-$x] set yerr [expr 150-$y] foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} { - test unixWm-2.$i {moving window while mapped} { + test unixWm-2.$i {moving window while mapped} unix { wm geom .t $geom update scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y @@ -84,7 +80,7 @@ foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} { set i 1 foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} { - test unixWm-3.$i {moving window while iconified} { + test unixWm-3.$i {moving window while iconified} unix { wm iconify .t sleep 200 wm geom .t $geom @@ -99,7 +95,7 @@ foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} { set i 1 foreach geom {+20+80 +100+40 +0+0} { - test unixWm-4.$i {moving window while withdrawn} { + test unixWm-4.$i {moving window while withdrawn} unix { wm withdraw .t sleep 200 wm geom .t $geom @@ -110,7 +106,7 @@ foreach geom {+20+80 +100+40 +0+0} { incr i } -test unixWm-5.1 {compounded state changes} {nonPortable} { +test unixWm-5.1 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -119,7 +115,7 @@ test unixWm-5.1 {compounded state changes} {nonPortable} { wm deiconify .t list [winfo ismapped .t] [wm state .t] } {1 normal} -test unixWm-5.2 {compounded state changes} {nonPortable} { +test unixWm-5.2 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -129,7 +125,7 @@ test unixWm-5.2 {compounded state changes} {nonPortable} { wm withdraw .t list [winfo ismapped .t] [wm state .t] } {0 withdrawn} -test unixWm-5.3 {compounded state changes} {nonPortable} { +test unixWm-5.3 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -140,7 +136,7 @@ test unixWm-5.3 {compounded state changes} {nonPortable} { wm deiconify .t list [winfo ismapped .t] [wm state .t] } {1 normal} -test unixWm-5.4 {compounded state changes} {nonPortable} { +test unixWm-5.4 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -150,7 +146,7 @@ test unixWm-5.4 {compounded state changes} {nonPortable} { wm iconify .t list [winfo ismapped .t] [wm state .t] } {0 iconic} -test unixWm-5.5 {compounded state changes} {nonPortable} { +test unixWm-5.5 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -159,7 +155,7 @@ test unixWm-5.5 {compounded state changes} {nonPortable} { wm withdraw .t list [winfo ismapped .t] [wm state .t] } {0 withdrawn} -test unixWm-5.6 {compounded state changes} {nonPortable} { +test unixWm-5.6 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -169,7 +165,7 @@ test unixWm-5.6 {compounded state changes} {nonPortable} { wm deiconify .t list [winfo ismapped .t] [wm state .t] } {1 normal} -test unixWm-5.7 {compounded state changes} {nonPortable} { +test unixWm-5.7 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -184,25 +180,25 @@ toplevel .t -width 200 -height 100 wm geom .t +10+10 wm minsize .t 1 1 update -test unixWm-6.1 {size changes} { +test unixWm-6.1 {size changes} unix { .t config -width 180 -height 150 update wm geom .t } 180x150+10+10 -test unixWm-6.2 {size changes} { +test unixWm-6.2 {size changes} unix { wm geom .t 250x60 .t config -width 170 -height 140 update wm geom .t } 250x60+10+10 -test unixWm-6.3 {size changes} { +test unixWm-6.3 {size changes} unix { wm geom .t 250x60 .t config -width 170 -height 140 wm geom .t {} update wm geom .t } 170x140+10+10 -test unixWm-6.4 {size changes} {nonPortable userInteraction} { +test unixWm-6.4 {size changes} {unix nonPortable userInteraction} { wm minsize .t 1 1 update puts stdout "Please resize window \"t\" with the mouse (but don't move it!)," @@ -229,7 +225,7 @@ test unixWm-6.4 {size changes} {nonPortable userInteraction} { # fails under twm. sleep 200 -test unixWm-6.5 {window initially iconic} {nonPortable} { +test unixWm-6.5 {window initially iconic} {unix nonPortable} { catch {destroy .t} toplevel .t -width 100 -height 30 wm geometry .t +0+0 @@ -249,22 +245,22 @@ foreach i {{Test label} Another {Yet another} {Last label}} j {1 2 3} { } wm geometry .m +[expr 100 - [winfo vrootx .]]+[expr 200 - [winfo vrooty .]] update -test unixWm-7.1 {override_redirect and Tk_MoveTopLevelWindow} { +test unixWm-7.1 {override_redirect and Tk_MoveTopLevelWindow} unix { list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m] } {1 normal 100 200} wm geometry .m +[expr 150 - [winfo vrootx .]]+[expr 210 - [winfo vrooty .]] update -test unixWm-7.2 {override_redirect and Tk_MoveTopLevelWindow} { +test unixWm-7.2 {override_redirect and Tk_MoveTopLevelWindow} unix { list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m] } {1 normal 150 210} wm withdraw .m -test unixWm-7.3 {override_redirect and Tk_MoveTopLevelWindow} { +test unixWm-7.3 {override_redirect and Tk_MoveTopLevelWindow} unix { list [winfo ismapped .m] } 0 destroy .m catch {destroy .t} -test unixWm-8.1 {icon windows} { +test unixWm-8.1 {icon windows} unix { catch {destroy .t} catch {destroy .icon} toplevel .t -width 100 -height 30 @@ -273,17 +269,17 @@ test unixWm-8.1 {icon windows} { wm iconwindow .t .icon list [catch {wm withdraw .icon} msg] $msg } {1 {can't withdraw .icon: it is an icon for .t}} -test unixWm-8.2 {icon windows} { +test unixWm-8.2 {icon windows} unix { catch {destroy .t} toplevel .t -width 100 -height 30 list [catch {wm iconwindow} msg] $msg } {1 {wrong # args: should be "wm option window ?arg ...?"}} -test unixWm-8.3 {icon windows} { +test unixWm-8.3 {icon windows} unix { catch {destroy .t} toplevel .t -width 100 -height 30 list [catch {wm iconwindow .t b c} msg] $msg } {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}} -test unixWm-8.4 {icon windows} { +test unixWm-8.4 {icon windows} unix { catch {destroy .t} catch {destroy .icon} toplevel .t -width 100 -height 30 @@ -300,18 +296,18 @@ test unixWm-8.4 {icon windows} { update lappend result [winfo ismapped .t] [winfo ismapped .icon] } {.icon icon {} withdrawn 1 0 0 0} -test unixWm-8.5 {icon windows} { +test unixWm-8.5 {icon windows} unix { catch {destroy .t} toplevel .t -width 100 -height 30 list [catch {wm iconwindow .t .gorp} msg] $msg } {1 {bad window path name ".gorp"}} -test unixWm-8.6 {icon windows} { +test unixWm-8.6 {icon windows} unix { catch {destroy .t} toplevel .t -width 100 -height 30 frame .t.icon -width 50 -height 50 -bg red list [catch {wm iconwindow .t .t.icon} msg] $msg } {1 {can't use .t.icon as icon window: not at top level}} -test unixWm-8.7 {icon windows} { +test unixWm-8.7 {icon windows} unix { catch {destroy .t} catch {destroy .icon} toplevel .t -width 100 -height 30 @@ -324,7 +320,7 @@ test unixWm-8.7 {icon windows} { lappend result [wm iconwindow .t] [wm state .icon] [wm state .icon2] } {.icon icon normal .icon2 withdrawn icon} catch {destroy .icon2} -test unixWm-8.8 {icon windows} { +test unixWm-8.8 {icon windows} unix { catch {destroy .t} catch {destroy .icon} toplevel .icon -width 50 -height 50 -bg red @@ -338,7 +334,7 @@ test unixWm-8.8 {icon windows} { sleep 500 lappend result [winfo ismapped .t] [winfo ismapped .icon] } {1 1 0} -test unixWm-8.9 {icon windows} {nonPortable} { +test unixWm-8.9 {icon windows} {unix nonPortable} { # This test is non-portable because some window managers will # destroy an icon window when it's associated window is destroyed. @@ -359,7 +355,7 @@ test unixWm-8.9 {icon windows} {nonPortable} { lappend result [winfo ismapped .icon] [wm state .icon] } {icon 1 0 0 withdrawn 1 normal} -test unixWm-8.10.1 {test for memory leaks} { +test unixWm-8.10.1 {test for memory leaks} unix { wm title .t "This is a long long long long long long title" wm title .t "This is a long long long long long long title" wm title .t "This is a long long long long long long title" @@ -370,7 +366,7 @@ test unixWm-8.10.1 {test for memory leaks} { wm title .t "This is a long long long long long long title" set x 1 } 1 -test unixWm-8.10.2 {test for memory leaks} { +test unixWm-8.10.2 {test for memory leaks} unix { wm group .t . wm group .t . wm group .t . @@ -384,14 +380,9 @@ test unixWm-8.10.2 {test for memory leaks} { set x 1 } 1 -if {[string compare testwrapper [info commands testwrapper]] != 0} { - puts "This application hasn't been compiled with the testwrapper command," - puts "therefore I am skipping all of these tests." - ::tcltest::cleanupTests - return -} +testConstraint testwrapper [llength [info commands testwrapper]] -test unixWm-9.1 {TkWmMapWindow procedure, client property} {unixOnly} { +test unixWm-9.1 {TkWmMapWindow procedure, client property} {unix testwrapper} { catch {destroy .t} toplevel .t -width 100 -height 50 wm geom .t +0+0 @@ -399,7 +390,7 @@ test unixWm-9.1 {TkWmMapWindow procedure, client property} {unixOnly} { update testprop [testwrapper .t] WM_CLIENT_MACHINE } {Test_String} -test unixWm-9.2 {TkWmMapWindow procedure, command property} {unixOnly} { +test unixWm-9.2 {TkWmMapWindow procedure, command property} {unix testwrapper} { catch {destroy .t} toplevel .t -width 100 -height 50 wm geom .t +0+0 @@ -433,6 +424,8 @@ test unixWm-9.5 {TkWmMapWindow procedure, normal windows} { winfo ismapped .t } {1} +testConstraint testmenubar [llength [info commands testmenubar]] + test unixWm-10.1 {TkWmDeadWindow procedure, canceling UpdateGeometry idle handler} { catch {destroy .t} toplevel .t -width 100 -height 50 @@ -441,7 +434,7 @@ test unixWm-10.1 {TkWmDeadWindow procedure, canceling UpdateGeometry idle handle .t configure -width 200 -height 100 destroy .t } {} -test unixWm-10.2 {TkWmDeadWindow procedure, destroying menubar} {unixOnly} { +test unixWm-10.2 {TkWmDeadWindow procedure, destroying menubar} {unix testmenubar} { catch {destroy .t} catch {destroy .f} toplevel .t -width 300 -height 200 -bd 2 -relief raised @@ -520,7 +513,7 @@ test unixWm-12.11 {Tk_WmCmd procedure, "aspect" option} { test unixWm-13.1 {Tk_WmCmd procedure, "client" option} { list [catch {wm client .t x y} msg] $msg } {1 {wrong # arguments: must be "wm client window ?name?"}} -test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unixOnly} { +test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unix testwrapper} { set result {} lappend result [wm client .t] wm client .t Test_String @@ -600,7 +593,7 @@ test unixWm-15.1 {Tk_WmCmd procedure, "command" option} { test unixWm-15.2 {Tk_WmCmd procedure, "command" option} { list [catch {wm command .t 12 13} msg] $msg } {1 {wrong # arguments: must be "wm command window ?value?"}} -test unixWm-15.3 {Tk_WmCmd procedure, "command" option} {unixOnly} { +test unixWm-15.3 {Tk_WmCmd procedure, "command" option} {unix testwrapper} { set result {} lappend result [wm command .t] wm command .t "test command" @@ -765,7 +758,7 @@ test unixWm-21.1 {Tk_WmCmd procedure, "group" option} { test unixWm-21.2 {Tk_WmCmd procedure, "group" option} { list [catch {wm group .t bogus} msg] $msg } {1 {bad window path name "bogus"}} -test unixWm-21.3 {Tk_WmCmd procedure, "group" option} {unixOnly} { +test unixWm-21.3 {Tk_WmCmd procedure, "group" option} {unix testwrapper} { set result {} lappend result [wm group .t] wm group .t . @@ -777,7 +770,7 @@ test unixWm-21.3 {Tk_WmCmd procedure, "group" option} {unixOnly} { WM_HINTS] 0]]] lappend result [wm group .t] $bit } {{} . 0x40 {} 0x0} -test unixWm-21.4 {Tk_WmCmd procedure, "group" option, make window exist} {unixOnly} { +test unixWm-21.4 {Tk_WmCmd procedure, "group" option, make window exist} {unix testwrapper} { catch {destroy .t2} toplevel .t2 wm geom .t2 +0+0 @@ -787,7 +780,7 @@ test unixWm-21.4 {Tk_WmCmd procedure, "group" option, make window exist} {unixOn destroy .t2 set result } {0} -test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {unixOnly} { +test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {unix testwrapper} { catch {destroy .t2} catch {destroy .t3} toplevel .t2 -width 120 -height 300 @@ -804,7 +797,7 @@ test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {un test unixWm-22.1 {Tk_WmCmd procedure, "iconbitmap" option} { list [catch {wm iconbitmap .t 12 13} msg] $msg } {1 {wrong # arguments: must be "wm iconbitmap window ?bitmap?"}} -test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unixOnly} { +test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unix testwrapper} { set result {} lappend result [wm iconbitmap .t] wm iconbitmap .t questhead @@ -876,7 +869,7 @@ test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} { test unixWm-24.1 {Tk_WmCmd procedure, "iconmask" option} { list [catch {wm iconmask .t 12 13} msg] $msg } {1 {wrong # arguments: must be "wm iconmask window ?bitmap?"}} -test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unixOnly} { +test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unix testwrapper} { set result {} lappend result [wm iconmask .t] wm iconmask .t questhead @@ -898,7 +891,7 @@ test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} { test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} { list [catch {wm iconname .t 12 13} msg] $msg } {1 {wrong # arguments: must be "wm iconname window ?newName?"}} -test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unixOnly} { +test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unix testwrapper} { set result {} lappend result [wm iconname .t] wm iconname .t test_name @@ -913,7 +906,7 @@ test unixWm-26.1 {Tk_WmCmd procedure, "iconposition" option} { test unixWm-26.2 {Tk_WmCmd procedure, "iconposition" option} { list [catch {wm iconposition .t 12 13 14} msg] $msg } {1 {wrong # arguments: must be "wm iconposition window ?x y?"}} -test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unixOnly} { +test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unix testwrapper} { set result {} lappend result [wm iconposition .t] wm iconposition .t 10 15 @@ -935,7 +928,7 @@ test unixWm-26.5 {Tk_WmCmd procedure, "iconposition" option} { test unixWm-27.1 {Tk_WmCmd procedure, "iconwindow" option} { list [catch {wm iconwindow .t 12 13} msg] $msg } {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}} -test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unixOnly} { +test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unix testwrapper} { catch {destroy .icon} toplevel .icon -width 50 -height 50 -bg green set result {} @@ -1054,7 +1047,7 @@ test unixWm-30.3 {Tk_WmCmd procedure, "overrideredirect" option} { test unixWm-31.1 {Tk_WmCmd procedure, "positionfrom" option} { list [catch {wm positionfrom .t 1 2} msg] $msg } {1 {wrong # arguments: must be "wm positionfrom window ?user/program?"}} -test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unixOnly} { +test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unix testwrapper} { set result {} lappend result [wm positionfrom .t] wm positionfrom .t program @@ -1083,7 +1076,7 @@ test unixWm-32.2 {Tk_WmCmd procedure, "protocol" option} { wm protocol .t bar {} set result } {bar {foo a}} -test unixWm-32.3 {Tk_WmCmd procedure, "protocol" option} {unixOnly} { +test unixWm-32.3 {Tk_WmCmd procedure, "protocol" option} {unix testwrapper} { set result {} lappend result [wm protocol .t] set x {} @@ -1157,7 +1150,7 @@ test unixWm-33.6 {Tk_WmCmd procedure, "resizable" option} { test unixWm-34.1 {Tk_WmCmd procedure, "sizefrom" option} { list [catch {wm sizefrom .t 1 2} msg] $msg } {1 {wrong # arguments: must be "wm sizefrom window ?user|program?"}} -test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unixOnly} { +test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unix testwrapper} { set result {} lappend result [wm sizefrom .t] wm sizefrom .t program @@ -1219,7 +1212,7 @@ test unixWm-35.4 {Tk_WmCmd procedure, "state" option} { test unixWm-36.1 {Tk_WmCmd procedure, "title" option} { list [catch {wm title .t 1 2} msg] $msg } {1 {wrong # arguments: must be "wm title window ?newTitle?"}} -test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unixOnly} { +test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unix testwrapper} { set result {} lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME] wm title .t "Test window" @@ -1228,7 +1221,7 @@ test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unixOnly} { lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME] } {t t {Test window} {Test window}} -test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unixOnly} { +test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unix testwrapper} { set result {} catch {destroy .t2} toplevel .t2 -width 120 -height 300 @@ -1245,7 +1238,7 @@ test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unixOnly} { destroy .t2 set result } {{} {} .t 0 {} 0x0} -test unixWm-37.4 {TkWmDeadWindow, destroy on master should clear transient} {unixOnly} { +test unixWm-37.4 {TkWmDeadWindow, destroy on master should clear transient} {unix testwrapper} { catch {destroy .t2} toplevel .t2 catch {destroy .t3} @@ -1256,7 +1249,7 @@ test unixWm-37.4 {TkWmDeadWindow, destroy on master should clear transient} {uni update list [wm transient .t2] [testprop [testwrapper .t2] WM_TRANSIENT_FOR] } {{} 0x0} -test unixWm-37.5 {Tk_WmCmd procedure, "transient" option, create master wrapper} {unixOnly} { +test unixWm-37.5 {Tk_WmCmd procedure, "transient" option, create master wrapper} {unix testwrapper} { catch {destroy .t2} catch {destroy .t3} toplevel .t2 -width 120 -height 300 @@ -1329,7 +1322,7 @@ test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} { sleep 500 lappend result [winfo width .t] [winfo height .t] } {400 150 200 300} -test unixWm-41.2 {ConfigureEvent procedure, menubars} {nonPortable} { +test unixWm-41.2 {ConfigureEvent procedure, menubars} {nonPortable testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -1513,7 +1506,7 @@ test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} { } [list [expr [winfo screenwidth .t] - 110] 2] catch {destroy .t} -test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unixOnly} { +test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unix testwrapper} { catch {destroy .t} toplevel .t -width 80 -height 60 wm resizable .t 0 0 @@ -1525,7 +1518,7 @@ test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unix list [expr [lindex $property 5]] [expr [lindex $property 6]] \ [expr [lindex $property 7]] [expr [lindex $property 8]] } {180 20 180 20} -test unixWm-44.10 {UpdateGeometryInfo procedure, menubar changing} { +test unixWm-44.10 {UpdateGeometryInfo procedure, menubar changing} testmenubar { catch {destroy .t} toplevel .t -width 80 -height 60 wm resizable .t 0 0 @@ -1540,7 +1533,7 @@ test unixWm-44.10 {UpdateGeometryInfo procedure, menubar changing} { list [update] [destroy .t] } {{} {}} -test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unixOnly} { +test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unix testwrapper} { catch {destroy .t} toplevel .t -width 80 -height 60 wm grid .t 6 10 10 5 @@ -1553,7 +1546,7 @@ test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unixOnly} { [expr [lindex $property 7]] [expr [lindex $property 8]] \ [expr [lindex $property 9]] [expr [lindex $property 10]] } {40 30 320 210 10 5} -test unixWm-45.2 {UpdateSizeHints procedure} {unixOnly} { +test unixWm-45.2 {UpdateSizeHints procedure} {unix testwrapper} { catch {destroy .t} toplevel .t -width 80 -height 60 wm minsize .t 30 40 @@ -1565,7 +1558,7 @@ test unixWm-45.2 {UpdateSizeHints procedure} {unixOnly} { [expr [lindex $property 7]] [expr [lindex $property 8]] \ [expr [lindex $property 9]] [expr [lindex $property 10]] } {30 40 200 500 1 1} -test unixWm-45.3 {UpdateSizeHints procedure, grid with menu} { +test unixWm-45.3 {UpdateSizeHints procedure, grid with menu} {testmenubar testwrapper} { catch {destroy .t} toplevel .t -width 80 -height 60 frame .t.menu -height 23 -width 50 @@ -1581,7 +1574,7 @@ test unixWm-45.3 {UpdateSizeHints procedure, grid with menu} { [expr [lindex $property 7]] [expr [lindex $property 8]] \ [expr [lindex $property 9]] [expr [lindex $property 10]] } {60 40 53 320 233 10 5} -test unixWm-45.4 {UpdateSizeHints procedure, not resizable with menu} { +test unixWm-45.4 {UpdateSizeHints procedure, not resizable with menu} {testmenubar testwrapper} { catch {destroy .t} toplevel .t -width 80 -height 60 frame .t.menu -height 23 -width 50 @@ -1708,7 +1701,7 @@ test unixWm-49.1 {Tk_GetRootCoords procedure} { tkwait visibility .t list [winfo rootx .t.f.f] [winfo rooty .t.f.f] } {202 192} -test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unixOnly} { +test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -1810,7 +1803,7 @@ test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} { interp delete slave set result } {{} .} -test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unixOnly} { +test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unix testmenubar} { eval destroy [winfo children .] toplevel .t -width 300 -height 400 -bd 2 -relief raised frame .t.f -width 150 -height 120 -bg green @@ -2159,7 +2152,7 @@ test unixWm-54.2 {TkpMakeMenuWindow procedure, setting override_redirect} { # No tests for TkGetPointerCoords, CreateWrapper, or GetMaxSize. -test unixWm-55.1 {TkUnixSetMenubar procedure} {unixOnly} { +test unixWm-55.1 {TkUnixSetMenubar procedure} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -2171,7 +2164,7 @@ test unixWm-55.1 {TkUnixSetMenubar procedure} {unixOnly} { [expr [winfo rootx .t] - [winfo rootx .t.f]] \ [expr [winfo rooty .t] - [winfo rooty .t.f]] } {1 300x30+0+0 0 30} -test unixWm-55.2 {TkUnixSetMenubar procedure, removing menubar} {unixOnly} { +test unixWm-55.2 {TkUnixSetMenubar procedure, removing menubar} {unix testmenubar} { catch {destroy .t} catch {destroy .f} toplevel .t -width 300 -height 200 -bd 2 -relief raised @@ -2190,7 +2183,7 @@ test unixWm-55.2 {TkUnixSetMenubar procedure, removing menubar} {unixOnly} { [expr [winfo rootx .] - [winfo rootx .f]] \ [expr [winfo rooty .] - [winfo rooty .f]] } {0 300x30+0+0 0 0 0 0} -test unixWm-55.3 {TkUnixSetMenubar procedure, removing geometry manager} {unixOnly} { +test unixWm-55.3 {TkUnixSetMenubar procedure, removing geometry manager} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -2207,7 +2200,7 @@ test unixWm-55.3 {TkUnixSetMenubar procedure, removing geometry manager} {unixOn update lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] } {0 0 0 0} -test unixWm-55.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unixOnly} { +test unixWm-55.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green @@ -2218,7 +2211,7 @@ test unixWm-55.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unixOnl [expr [winfo rootx .t] - [winfo rootx .t.f]] \ [expr [winfo rooty .t] - [winfo rooty .t.f]] } {1 300x30+0+0 0 30} -test unixWm-55.5 {TkUnixSetMenubar procedure, changing menubar} {unixOnly} { +test unixWm-55.5 {TkUnixSetMenubar procedure, changing menubar} {unix testmenubar} { catch {destroy .t} catch {destroy .f} toplevel .t -width 300 -height 200 -bd 2 -relief raised @@ -2237,7 +2230,7 @@ test unixWm-55.5 {TkUnixSetMenubar procedure, changing menubar} {unixOnly} { lappend result [winfo ismapped .f] [winfo ismapped .t.f] lappend result [expr [winfo rooty .f] - $y] } {0 1 0 1 0 0} -test unixWm-55.6 {TkUnixSetMenubar procedure, changing menubar to self} {unixOnly} { +test unixWm-55.6 {TkUnixSetMenubar procedure, changing menubar to self} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green @@ -2250,7 +2243,7 @@ test unixWm-55.6 {TkUnixSetMenubar procedure, changing menubar to self} {unixOnl [expr [winfo rootx .t] - [winfo rootx .t.f]] \ [expr [winfo rooty .t] - [winfo rooty .t.f]] } {1 300x30+0+0 0 30} -test unixWm-55.7 {TkUnixSetMenubar procedure, unsetting event handler} {unixOnly} { +test unixWm-55.7 {TkUnixSetMenubar procedure, unsetting event handler} {unix testmenubar} { catch {destroy .t} catch {destroy .f} toplevel .t -width 300 -height 200 -bd 2 -relief raised @@ -2270,7 +2263,7 @@ test unixWm-55.7 {TkUnixSetMenubar procedure, unsetting event handler} {unixOnly lappend result [expr [winfo rooty .t] - $y] } {30 40 40} -test unixWm-56.1 {MenubarDestroyProc procedure} {unixOnly} { +test unixWm-56.1 {MenubarDestroyProc procedure} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -2285,7 +2278,7 @@ test unixWm-56.1 {MenubarDestroyProc procedure} {unixOnly} { lappend result [expr [winfo rooty .t] - $y] } {30 0} -test unixWm-57.1 {MenubarReqProc procedure} {unixOnly} { +test unixWm-57.1 {MenubarReqProc procedure} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -2300,7 +2293,7 @@ test unixWm-57.1 {MenubarReqProc procedure} {unixOnly} { update lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] } {0 10 0 100} -test unixWm-57.2 {MenubarReqProc procedure} {unixOnly} { +test unixWm-57.2 {MenubarReqProc procedure} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -2316,7 +2309,7 @@ test unixWm-57.2 {MenubarReqProc procedure} {unixOnly} { lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] } {0 20 0 1} -test unixWm-58.1 {UpdateCommand procedure, DString gets reallocated} {unixOnly} { +test unixWm-58.1 {UpdateCommand procedure, DString gets reallocated} {unix testwrapper} { catch {destroy .t} toplevel .t -width 100 -height 50 wm geom .t +0+0 @@ -2350,43 +2343,37 @@ argumentNumber18 # Test exit processing and cleanup: test unixWm-59.1 {exit processing} { - catch {removeFile script} - set fd [open script w] - puts $fd { + set script [makeFile { update exit - } - close $fd - if {[catch {exec [interpreter] script -geometry 10x10+0+0} msg]} { + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } + removeFile script list $error $msg } {0 {}} test unixWm-59.2 {exit processing} { - catch {removeFile script} - set fd [open script w] - puts $fd { + set script [makeFile { interp create x x eval {set argc 2} x eval {set argv "-geometry 10x10+0+0"} x eval {load {} Tk} update exit - } - close $fd - if {[catch {exec [interpreter] script -geometry 10x10+0+0} msg]} { + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } + removeFile script list $error $msg } {0 {}} test unixWm-59.3 {exit processing} { - catch {removeFile script} - set fd [open script w] - puts $fd { + set script [makeFile { interp create x x eval {set argc 2} x eval {set argv "-geometry 10x10+0+0"} @@ -2399,13 +2386,13 @@ test unixWm-59.3 {exit processing} { proc destroy_x {} {interp delete x} update exit - } - close $fd - if {[catch {exec [interpreter] script -geometry 10x10+0+0} msg]} { + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } + removeFile script list $error $msg } {0 {}} @@ -2422,6 +2409,5 @@ test unixWm-60.2 {wm attributes} { # cleanup catch {destroy .t} -catch {removeFile script} ::tcltest::cleanupTests return -- cgit v0.12