diff options
Diffstat (limited to 'tests/unixWm.test')
-rw-r--r-- | tests/unixWm.test | 93 |
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 + + + + + + + + + + + + + |