summaryrefslogtreecommitdiffstats
path: root/tests/menu.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/menu.test')
-rw-r--r--tests/menu.test115
1 files changed, 60 insertions, 55 deletions
diff --git a/tests/menu.test b/tests/menu.test
index 1b8cc26..dccdf52 100644
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -5,12 +5,13 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: menu.test,v 1.22 2008/08/13 23:57:05 aniap Exp $
+# RCS: @(#) $Id: menu.test,v 1.23 2009/01/13 01:46:06 patthoyts Exp $
package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands
+imageInit
# find the earth.gif file for use in these tests (tests 2.*)
set earthPhotoFile [file join [file dirname [info script]] earth.gif]
@@ -2265,7 +2266,7 @@ test menu-7.8 {UnhookCascadeEntry} -setup {
list [destroy .m1] [destroy .m2]
} -returnCodes ok -result {{} {}}
test menu-7.9 {UnhookCascadeEntry} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
menu .m2
@@ -2275,7 +2276,7 @@ test menu-7.9 {UnhookCascadeEntry} -setup {
} -returnCodes ok
test menu-8.1 {DestroyMenuEntry} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
menu .m2
@@ -2283,7 +2284,7 @@ test menu-8.1 {DestroyMenuEntry} -setup {
list [.m1 delete 1] [destroy .m1 .m2]
} -result {{} {}}
test menu-8.2 {DestroyMenuEntry} -constraints hasEarthPhoto -setup {
- deleteWindows
+ deleteWindows
catch {image delete image1a}
} -body {
image create photo image1a -file $earthPhotoFile
@@ -2292,16 +2293,19 @@ test menu-8.2 {DestroyMenuEntry} -constraints hasEarthPhoto -setup {
list [.m1 delete 1] [destroy .m1] [image delete image1a]
} -result {{} {} {}}
test menu-8.3 {DestroyMenuEntry} -constraints testImageType -setup {
- deleteWindows
- catch {eval image delete [image names]}
+ deleteWindows
+ imageCleanup
} -body {
image create test image1
image create test image2
menu .m1
.m1 add checkbutton -image image1 -selectimage image2
.m1 invoke 1
- list [.m1 delete 1] [destroy .m1] [eval image delete [image names]]
-} -result {{} {} {}}
+ list [.m1 delete 1] [destroy .m1]
+} -cleanup {
+ imageCleanup
+ deleteWindows
+} -result {{} {}}
test menu-8.4 {DestroyMenuEntry} -setup {
destroy .m1
} -body {
@@ -2599,31 +2603,31 @@ test menu-11.16 {ConfigureMenuEntry} -setup {
deleteWindows
} -result {}
test menu-11.17 {ConfigureMenuEntry} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add checkbutton
list [.m1 entryconfigure 1 -onvalue "test"] [.m1 entrycget 1 -onvalue]
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {{} test}
test menu-11.18 {ConfigureMenuEntry} -constraints testImageType -setup {
- deleteWindows
- catch {image delete image1}
+ deleteWindows
+ imageCleanup
} -body {
menu .m1
.m1 add command
image create test image1
.m1 entryconfigure 1 -image image1
} -cleanup {
- deleteWindows
- image delete image1
+ deleteWindows
+ imageCleanup
} -result {}
test menu-11.19 {ConfigureMenuEntry} -constraints {
- testImageType hasEarthPhoto
+ testImageType hasEarthPhoto
} -setup {
- deleteWindows
- catch {image delete image1 image2}
+ deleteWindows
+ imageCleanup
} -body {
image create test image1
image create photo image2 -file $earthPhotoFile
@@ -2631,14 +2635,14 @@ test menu-11.19 {ConfigureMenuEntry} -constraints {
.m1 add command -image image1
.m1 entryconfigure 1 -image image2
} -cleanup {
- deleteWindows
- image delete image1 image2
+ deleteWindows
+ imageCleanup
} -result {}
test menu-11.20 {ConfigureMenuEntry} -constraints {
- testImageType hasEarthPhoto
+ testImageType hasEarthPhoto
} -setup {
- deleteWindows
- catch {image delete image1 image2}
+ deleteWindows
+ imageCleanup
} -body {
image create photo image1 -file $earthPhotoFile
image create test image2
@@ -2646,14 +2650,14 @@ test menu-11.20 {ConfigureMenuEntry} -constraints {
.m1 add checkbutton -image image1
.m1 entryconfigure 1 -selectimage image2
} -cleanup {
- deleteWindows
- image delete image1 image2
+ deleteWindows
+ imageCleanup
} -result {}
test menu-11.21 {ConfigureMenuEntry} -constraints {
- testImageType hasEarthPhoto
+ testImageType hasEarthPhoto
} -setup {
- deleteWindows
- catch {image delete image1 image2 image3}
+ deleteWindows
+ imageCleanup
} -body {
image create photo image1 -file $earthPhotoFile
image create test image2
@@ -2662,13 +2666,13 @@ test menu-11.21 {ConfigureMenuEntry} -constraints {
.m1 add checkbutton -image image1 -selectimage image2
.m1 entryconfigure 1 -selectimage image3
} -cleanup {
- deleteWindows
- image delete image1 image2 image3
+ deleteWindows
+ imageCleanup
} -result {}
test menu-12.1 {ConfigureMenuCloneEntries} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 clone .m2
@@ -2678,10 +2682,10 @@ test menu-12.1 {ConfigureMenuCloneEntries} -setup {
.m1 add command -label "test2"
.m1 entryconfigure 1 -gork "foo"
} -cleanup {
- deleteWindows
+ deleteWindows
} -returnCodes error -result {unknown option "-gork"}
test menu-12.2 {ConfigureMenuCloneEntries} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 clone .m2
@@ -2690,20 +2694,20 @@ test menu-12.2 {ConfigureMenuCloneEntries} -setup {
menu .m4
.m1 entryconfigure 1 -menu .m4
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {}
test menu-12.3 {ConfigureMenuCloneEntries} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 clone .m2
.m1 add cascade -label dummy
.m1 entryconfigure dummy -menu .m3
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {}
test menu-12.4 {ConfigureMenuCloneEntries} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add cascade -label File -menu .m1.foo
@@ -2712,12 +2716,12 @@ test menu-12.4 {ConfigureMenuCloneEntries} -setup {
.m1 clone .m2
.m1 entryconfigure File -state disabled
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {}
test menu-13.1 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "active"
@@ -2726,10 +2730,10 @@ test menu-13.1 {TkGetMenuIndex} -setup {
.m1 activate 2
.m1 entrycget active -label
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {test2}
test menu-13.2 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "last"
@@ -2738,10 +2742,10 @@ test menu-13.2 {TkGetMenuIndex} -setup {
.m1 activate 2
.m1 entrycget last -label
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {test3}
test menu-13.3 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "last"
@@ -2750,28 +2754,28 @@ test menu-13.3 {TkGetMenuIndex} -setup {
.m1 activate 2
.m1 entrycget end -label
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {test3}
test menu-13.4 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "test"
list [.m1 insert last command -label "test2"] [.m1 entrycget last -label]
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {{} test2}
test menu-13.5 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "test"
list [.m1 insert end command -label "test2"] [.m1 entrycget end -label]
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {{} test2}
test menu-13.6 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "active"
@@ -2780,11 +2784,11 @@ test menu-13.6 {TkGetMenuIndex} -setup {
.m1 activate 2
.m1 entrycget none -label
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {}
#test menu-13.7 - Need to add @test here.
test menu-13.7 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "active"
@@ -2792,10 +2796,10 @@ test menu-13.7 {TkGetMenuIndex} -setup {
.m1 add command -label "test3"
.m1 entrycget 1 -label
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {active}
test menu-13.8 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "active"
@@ -3809,10 +3813,11 @@ test menu-35.1 {menu -underline string overruns Bug 1599877} -setup {
} -result {}
# cleanup
+imageFinish
deleteWindows
cleanupTests
return
-
-
-
+# Local variables:
+# mode: tcl
+# End:
generated by cgit v0.12 at 2024-07-21 10:21:05 (GMT)