summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhershey <hershey>1999-04-19 23:54:56 (GMT)
committerhershey <hershey>1999-04-19 23:54:56 (GMT)
commitc999728b7c7b84d88a81c5e223f2a5821eafe4f7 (patch)
tree875f348f732fae90d23763d73f4c43b5d7413f86
parent3f100af6bdc13e0abd205827a2e697ef5a213c86 (diff)
downloadtk-c999728b7c7b84d88a81c5e223f2a5821eafe4f7.zip
tk-c999728b7c7b84d88a81c5e223f2a5821eafe4f7.tar.gz
tk-c999728b7c7b84d88a81c5e223f2a5821eafe4f7.tar.bz2
changed tests--marked some nonPortable; added new constraints to fix bug 1770
-rw-r--r--tests/all.tcl4
-rw-r--r--tests/menubut.test6
-rw-r--r--tests/pack.test15
-rw-r--r--tests/scale.test6
-rw-r--r--tests/textIndex.test4
-rw-r--r--tests/unixEmbed.test5
-rw-r--r--tests/unixWm.test4
7 files changed, 29 insertions, 15 deletions
diff --git a/tests/all.tcl b/tests/all.tcl
index fc2b89d..208ca5a 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -7,9 +7,9 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: all.tcl,v 1.2 1999/04/16 01:51:33 stanton Exp $
+# RCS: @(#) $Id: all.tcl,v 1.3 1999/04/19 23:54:56 hershey Exp $
-if {[lsearch ::tcltest [namespace children]] == -1} {
+if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
}
set ::tcltest::testSingleFile false
diff --git a/tests/menubut.test b/tests/menubut.test
index 89d46d8..c0c705c 100644
--- a/tests/menubut.test
+++ b/tests/menubut.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: menubut.test,v 1.3 1999/04/16 01:51:39 stanton Exp $
+# RCS: @(#) $Id: menubut.test,v 1.4 1999/04/19 23:54:56 hershey Exp $
# XXX This test file is woefully incomplete right now. If any part
# XXX of a procedure has tests then the whole procedure has tests,
@@ -191,7 +191,7 @@ test menubutton-4.4 {ConfigureMenuButton procedure} {
(processing -height option)
invoked from within
".mb1 configure -height 0.5x"}}
-test menubutton-4.5 {ConfigureMenuButton procedure} {fonts} {
+test menubutton-4.5 {ConfigureMenuButton procedure} {nonPortable fonts} {
catch {destroy .mb1}
button .mb1 -text "Sample text" -width 10 -height 2
pack .mb1
@@ -307,7 +307,7 @@ test menubutton-7.12 {ComputeMenuButtonGeometry procedure} {fonts} {
pack .mb
list [winfo reqwidth .mb] [winfo reqheight .mb]
} {62 30}
-test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {fonts} {
+test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {nonPortable fonts} {
catch {destroy .mb}
menubutton .mb -text String -bd 2 -relief raised \
-highlightthickness 1 -indicatoron 1
diff --git a/tests/pack.test b/tests/pack.test
index 6f6adbd..dab196a 100644
--- a/tests/pack.test
+++ b/tests/pack.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: pack.test,v 1.3 1999/04/16 01:51:40 stanton Exp $
+# RCS: @(#) $Id: pack.test,v 1.4 1999/04/19 23:54:56 hershey Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -924,6 +924,13 @@ test pack-17.1 {PackLostSlaveProc procedure} {
} {place 20x40+40+10 1 {window ".pack.a" isn't packed}}
test pack-18.1 {unmap slaves when master unmapped} {tempNotPc} {
+
+ # adjust the position of .pack before test to avoid a screen switch
+ # that occurs with window managers that have desktops four times as big
+ # as the screen (screen switch causes scale and other tests to fail).
+
+ wm geometry .pack +100+100
+
# On the PC, when the width/height is configured while the window is
# unmapped, the changes don't take effect until the window is remapped.
# Who knows why?
@@ -945,6 +952,12 @@ test pack-18.1 {unmap slaves when master unmapped} {tempNotPc} {
lappend result [winfo ismapped .pack.a]
} {1 0 200 75 0 1}
test pack-18.2 {unmap slaves when master unmapped} {
+
+ # adjust the position of .pack before test to avoid a screen switch
+ # that occurs with window managers that have desktops four times as big
+ # as the screen (screen switch causes scale and other tests to fail).
+
+ wm geometry .pack +100+100
eval destroy [winfo child .pack]
frame .pack.a -relief raised -bd 2
frame .pack.b -width 70 -height 30 -relief sunken -bd 2
diff --git a/tests/scale.test b/tests/scale.test
index 01b1609..f52c050 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: scale.test,v 1.4 1999/04/16 01:51:40 stanton Exp $
+# RCS: @(#) $Id: scale.test,v 1.5 1999/04/19 23:54:57 hershey Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -396,7 +396,7 @@ test scale-6.20 {ComputeFormat procedure} {
.s get
} {1001.235}
-test scale-7.1 {ComputeScaleGeometry procedure} {fonts} {
+test scale-7.1 {ComputeScaleGeometry procedure} {nonPortable fonts} {
catch {destroy .s}
scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i
pack .s
@@ -426,7 +426,7 @@ test scale-7.4 {ComputeScaleGeometry procedure} {fonts} {
update
list [winfo reqwidth .s] [winfo reqheight .s]
} {39 114}
-test scale-7.5 {ComputeScaleGeometry procedure} {fonts} {
+test scale-7.5 {ComputeScaleGeometry procedure} {nonPortable fonts} {
catch {destroy .s}
scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i
pack .s
diff --git a/tests/textIndex.test b/tests/textIndex.test
index 2bfdbc1..b1e3f16 100644
--- a/tests/textIndex.test
+++ b/tests/textIndex.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textIndex.test,v 1.3 1999/04/16 01:51:41 stanton Exp $
+# RCS: @(#) $Id: textIndex.test,v 1.4 1999/04/19 23:54:57 hershey Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -252,7 +252,7 @@ test textIndex-4.8 {TkTextGetIndex, tags} {
set result
} {1.0 1.1}
-test textIndex-5.1 {TkTextGetIndex, "@"} {fonts} {
+test textIndex-5.1 {TkTextGetIndex, "@"} {nonPortable fonts} {
.t index @12,9
} 1.1
test textIndex-5.2 {TkTextGetIndex, "@"} {fonts} {
diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test
index 2f2970d..23b1c64 100644
--- a/tests/unixEmbed.test
+++ b/tests/unixEmbed.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: unixEmbed.test,v 1.5 1999/04/16 01:51:41 stanton Exp $
+# RCS: @(#) $Id: unixEmbed.test,v 1.6 1999/04/19 23:54:57 hershey Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -203,7 +203,8 @@ test unixEmbed-2.4 {EmbeddedEventProc procedure} {
list $x [testembed]
} {{{XXX .f1 {} {}}} {}}
-test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} {
+test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} \
+ {nonPortable} {
foreach w [winfo child .] {
catch {destroy $w}
}
diff --git a/tests/unixWm.test b/tests/unixWm.test
index 11528d6..6864037 100644
--- a/tests/unixWm.test
+++ b/tests/unixWm.test
@@ -7,7 +7,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: unixWm.test,v 1.5 1999/04/16 01:51:42 stanton Exp $
+# RCS: @(#) $Id: unixWm.test,v 1.6 1999/04/19 23:54:58 hershey Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -1594,7 +1594,7 @@ test unixWm-46.1 {WaitForEvent procedure, use of modal timeout} {
list $result $x
} {no yes}
-test unixWm-47.1 {WaitRestrictProc procedure} {
+test unixWm-47.1 {WaitRestrictProc procedure} {nonPOrtable} {
catch {destroy .t}
toplevel .t -width 300 -height 200
frame .t.f -bd 2 -relief raised