changed tests--marked some nonPortable; added new constraints to fix bug 1770

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