summaryrefslogtreecommitdiffstats
path: root/tests/unixWm.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/unixWm.test')
-rw-r--r--tests/unixWm.test93
1 files changed, 72 insertions, 21 deletions
diff --git a/tests/unixWm.test b/tests/unixWm.test
index f70c589..11528d6 100644
--- a/tests/unixWm.test
+++ b/tests/unixWm.test
@@ -4,18 +4,19 @@
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unixWm.test,v 1.4 1999/02/04 21:03:28 stanton Exp $
+# RCS: @(#) $Id: unixWm.test,v 1.5 1999/04/16 01:51:42 stanton Exp $
-if {$tcl_platform(platform) != "unix"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
-if {[string compare test [info procs test]] == 1} {
- source defs
+if {$tcl_platform(platform) != "unix"} {
+ puts "skipping: Unix only tests..."
+ ::tcltest::cleanupTests
+ return
}
proc sleep ms {
@@ -195,7 +196,7 @@ test unixWm-6.3 {size changes} {
update
wm geom .t
} 170x140+10+10
-test unixWm-6.4 {size changes} {nonPortable} {
+test unixWm-6.4 {size changes} {nonPortable userInteraction} {
wm minsize .t 1 1
update
puts stdout "Please resize window \"t\" with the mouse (but don't move it!),"
@@ -355,6 +356,7 @@ test unixWm-8.9 {icon windows} {nonPortable} {
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
}
@@ -1309,7 +1311,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} {unixOnly} {
+test unixWm-41.2 {ConfigureEvent procedure, menubars} {nonPortable} {
catch {destroy .t}
toplevel .t -width 300 -height 200 -bd 2 -relief raised
wm geom .t +0+0
@@ -1473,22 +1475,26 @@ test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} {
update
list [winfo width .t] [winfo height .t]
} {100 1}
+
+catch {destroy .t}
+toplevel .t -width 80 -height 60
test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} {
- catch {destroy .t}
- toplevel .t -width 80 -height 60
wm geometry .t +5-10
wm overrideredirect .t 1
tkwait visibility .t
list [winfo x .t] [winfo y .t]
-} "5 [expr [winfo screenheight .t] - 70]"
+} [list 5 [expr [winfo screenheight .t] - 70]]
+
+catch {destroy .t}
+toplevel .t -width 80 -height 60
test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {
- catch {destroy .t}
- toplevel .t -width 80 -height 60
wm geometry .t -30+2
wm overrideredirect .t 1
tkwait visibility .t
list [winfo x .t] [winfo y .t]
-} "[expr [winfo screenwidth .t] - 110] 2"
+} [list [expr [winfo screenwidth .t] - 110] 2]
+catch {destroy .t}
+
test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unixOnly} {
catch {destroy .t}
toplevel .t -width 80 -height 60
@@ -2291,6 +2297,37 @@ 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} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 50
+ wm geom .t +0+0
+ wm command .t "argumentNumber0 argumentNumber1 argumentNumber2 argumentNumber0 argumentNumber3 argumentNumber4 argumentNumber5 argumentNumber6 argumentNumber0 argumentNumber7 argumentNumber8 argumentNumber9 argumentNumber10 argumentNumber0 argumentNumber11 argumentNumber12 argumentNumber13 argumentNumber14 argumentNumber15 argumentNumber16 argumentNumber17 argumentNumber18"
+ update
+ testprop [testwrapper .t] WM_COMMAND
+} {argumentNumber0
+argumentNumber1
+argumentNumber2
+argumentNumber0
+argumentNumber3
+argumentNumber4
+argumentNumber5
+argumentNumber6
+argumentNumber0
+argumentNumber7
+argumentNumber8
+argumentNumber9
+argumentNumber10
+argumentNumber0
+argumentNumber11
+argumentNumber12
+argumentNumber13
+argumentNumber14
+argumentNumber15
+argumentNumber16
+argumentNumber17
+argumentNumber18
+}
+
# Test exit processing and cleanup:
test unixWm-58.1 {exit processing} {
@@ -2301,7 +2338,7 @@ test unixWm-58.1 {exit processing} {
exit
}
close $fd
- if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
+ if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} {
set error 1
} else {
set error 0
@@ -2320,7 +2357,7 @@ test unixWm-58.2 {exit processing} {
exit
}
close $fd
- if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
+ if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} {
set error 1
} else {
set error 0
@@ -2345,7 +2382,7 @@ test unixWm-58.3 {exit processing} {
exit
}
close $fd
- if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
+ if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} {
set error 1
} else {
set error 0
@@ -2353,7 +2390,21 @@ test unixWm-58.3 {exit processing} {
list $error $msg
} {0 {}}
-
+# cleanup
catch {destroy .t}
catch {removeFile script}
-concat {}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+