diff options
author | stanton <stanton> | 1999-04-16 01:51:06 (GMT) |
---|---|---|
committer | stanton <stanton> | 1999-04-16 01:51:06 (GMT) |
commit | 03656f44f81469f459031fa3a4a7b09c8bc77712 (patch) | |
tree | 31378e81bd58f8c726fc552d6b30cbf3ca07497b /tests/unixMenu.test | |
parent | 404fc236f34304df53b7e44bc7971d786b87d453 (diff) | |
download | tk-03656f44f81469f459031fa3a4a7b09c8bc77712.zip tk-03656f44f81469f459031fa3a4a7b09c8bc77712.tar.gz tk-03656f44f81469f459031fa3a4a7b09c8bc77712.tar.bz2 |
* Merged 8.1 branch into the main trunk
Diffstat (limited to 'tests/unixMenu.test')
-rw-r--r-- | tests/unixMenu.test | 42 |
1 files changed, 30 insertions, 12 deletions
diff --git a/tests/unixMenu.test b/tests/unixMenu.test index cd1e87b..ebc833b 100644 --- a/tests/unixMenu.test +++ b/tests/unixMenu.test @@ -4,13 +4,18 @@ # system. # # Copyright (c) 1995-1996 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: unixMenu.test,v 1.2 1998/09/14 18:23:52 stanton Exp $ +# RCS: @(#) $Id: unixMenu.test,v 1.3 1999/04/16 01:51:42 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} if {$tcl_platform(platform) != "unix"} { + puts "skipping: Unix only tests..." + ::tcltest::cleanupTests return } @@ -18,13 +23,10 @@ if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\" image" puts "type, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" + ::tcltest::cleanupTests return } -if {[info procs test] != "test"} { - source defs -} - proc deleteWindows {} { foreach i [winfo children .] { catch [destroy $i] @@ -332,8 +334,8 @@ test unixMenu-18.1 {GetTearoffEntryGeometry} { .mb.m add command -label test pack .mb raise . - list [catch {tkMbPost .mb} msg] $msg [destroy .mb] -} {0 {} {}} + list [catch {tkMbPost .mb} msg] $msg [tkMenuUnpost .mb.m] [destroy .mb] +} {0 {} {} {}} # Don't know how to reproduce the case where the tkwin has been deleted. test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} { @@ -848,8 +850,8 @@ test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} { .mb.m add command -label test pack .mb catch {tkMbPost .mb} - list [update] [destroy .mb] -} {{} {}} + list [update] [tkMenuUnpost .mb.m] [destroy .mb] +} {{} {} {}} test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} { catch {destroy .m1} menu .m1 @@ -966,4 +968,20 @@ test unixMenu-25.20 {TkpComputeStandardMenuGeometry - hide margin} { test unixMenu-26.1 {TkpMenuInit - nothing to do} {} {} +# cleanup deleteWindows +::tcltest::cleanupTests +return + + + + + + + + + + + + + |