menu.test

linux系统下的音频通信

    	    {unknown option "-onvalue"}
    	    on 
      	    {unknown option "-onvalue"}
	    }
	}}
    }
    {-selectcolor
    	{{#110022 
    	    {{unknown option "-selectcolor"} 
    	    {unknown option "-selectcolor"}
    	    {unknown option "-selectcolor"} 
    	    {unknown option "-selectcolor"}
    	    #110022
    	    #110022
	    }
	}
	{non-existent
	    {{unknown option "-selectcolor"} 
	    {unknown option "-selectcolor"}
	    {unknown option "-selectcolor"}
	    {unknown option "-selectcolor"}
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    }
	}}
    }
    {-selectimage
    	{{image1 
    	    {{unknown option "-selectimage"}
    	    {unknown option "-selectimage"}
    	    {unknown option "-selectimage"} 
    	    {unknown option "-selectimage"} image1 image1
	    }
	}
	{bogus
	    {{unknown option "-selectimage"} 
	    {unknown option "-selectimage"}
	    {unknown option "-selectimage"}
	    {unknown option "-selectimage"}
	    {image "bogus" doesn't exist}
	    {image "bogus" doesn't exist}
	    }
	}
	{""
	    {{unknown option "-selectimage"}
	    {unknown option "-selectimage"}
	    {unknown option "-selectimage"}
	    {unknown option "-selectimage"}
	    {}
	    {}
	    }
	}}
    }
    {-state
    	{{normal 
    	    {normal normal normal 
    	    {unknown option "-state"} normal normal
	    }
	}}
    }
    {-value
    	{{"any string"
    	    {{unknown option "-value"}
    	    {unknown option "-value"}
    	    {unknown option "-value"}
    	    {unknown option "-value"}
    	    {unknown option "-value"} "any string"
	    }
	}}
    }
    {-variable
    	{{"any string"
    	    {{unknown option "-variable"}
    	    {unknown option "-variable"}
    	    {unknown option "-variable"} 
    	    {unknown option "-variable"}
    	    "any string"
    	    "any string"
	    }
	}}
    }
    {-underline
    	{{0 
    	    {{unknown option "-underline"} 0 0 
    	    {unknown option "-underline"} 0 0
	    }
	}
	{3p
	    {{unknown option "-underline"} 
	    {expected integer but got "3p"}
	    {expected integer but got "3p"}
	    {unknown option "-underline"}
	    {expected integer but got "3p"}
	    {expected integer but got "3p"}
	    }
	}}
    }
} {
    set name [lindex $test 0]
    foreach attempt [lindex $test 1] {
    	set value [lindex $attempt 0]
    	set options [lindex $attempt 1]
    	foreach item {0 1 2 3 4 5} {
    	    catch {unset msg}
    	    test menu-2.$i [list entry configuration options $name $item $value] {
            	set result [catch {.m1 entryconfigure $item $name $value} msg]
                if {$result == 1} {
            	    set msg
            	} else {
            	    lindex [.m1 entryconfigure $item $name] 4
            	}
    	    } [lindex $options $item]
    	    incr i
    	}
    }
}

image delete image1
destroy .m1
destroy .m2

test menu-3.1 {MenuWidgetCmd procedure} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 option ?arg arg ...?"} {}}
test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {menuInteractive} {
    catch {destroy .m1}
    menu .m1 -postcommand "destroy .m1"
    .m1 add command -label "menu-3.2: Hit Escape"
    list [catch {.m1 post 40 40} msg] $msg
} {0 {}}
test menu-3.3 {MenuWidgetCmd procedure, "activate" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 activate} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 activate index"} {}}
test menu-3.4 {MenuWidgetCmd procedure, "activate" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 activate "foo"} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
test menu-3.5 {MenuWidgetCmd procedure, "activate" option}  {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add separator
    list [catch {.m1 activate 2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.6 {MenuWidgetCmd procedure, "activate" option}  {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 entryconfigure 1 -state disabled
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.7 {MenuWidgetCmd procedure, "activate" option}  {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.8 {MenuWidgetCmd procedure, "add" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 add type ?options?"} {}}
test menu-3.9 {MenuWidgetCmd procedure, "add" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add foo} msg] $msg [destroy .m1]
} {1 {bad menu entry type "foo": must be cascade, checkbutton, command, radiobutton, or separator} {}}
test menu-3.10 {MenuWidgetCmd procedure, "add" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add separator} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.11 {MenuWidgetCmd procedure, "cget" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 cget} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 cget option"} {}}
test menu-3.12 {MenuWidgetCmd procedure, "cget" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 cget -gorp} msg] $msg [destroy .m1]
} {1 {unknown option "-gorp"} {}}
test menu-3.13 {MenuWidgetCmd procedure, "cget" option} {
    catch {destroy .m1}
    menu .m1
    .m1 configure -postcommand "Some string"
    list [catch {.m1 cget -postcommand} msg] $msg [destroy .m1]
} {0 {Some string} {}}
test menu-3.14 {MenuWidgetCmd procedure, "clone" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 clone} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}}
test menu-3.15 {MenuWidgetCmd procedure, "clone" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 clone a b c d} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}}
test menu-3.16 {MenuWidgetCmd procedure, "clone" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 clone .m1.clone1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.17 {MenuWidgetCmd procedure, "clone" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 clone .m1.clone1 tearoff} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.18 {MenuWidgetCmd procedure, "configure" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {llength [.m1 configure]} msg] $msg [destroy .m1]
} {0 20 {}}
test menu-3.19 {MenuWidgetCmd procedure, "configure" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 configure -gorp} msg] $msg [destroy .m1]
} {1 {unknown option "-gorp"} {}}
test menu-3.20 {MenuWidgetCmd procedure, "configure" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 configure -postcommand "A random String"} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.21 {MenuWidgetCmd procedure, "configure" option} {
    catch {destroy .m1}
    menu .m1
    .m1 configure -postcommand "Another string"
    list [catch {lindex [.m1 configure -postcommand] 4} msg] $msg [destroy .m1]
} {0 {Another string} {}}
test menu-3.22 {MenuWidgetCmd procedure, "delete" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 delete} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 delete first ?last?"} {}}
test menu-3.23 {MenuWidgetCmd procedure, "delete" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 delete foo} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
test menu-3.24 {MenuWidgetCmd procedure, "delete" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 delete 0 "foo"} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
test menu-3.25 {MenuWidgetCmd procedure, "delete" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 delete 0} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.26 {MenuWidgetCmd procedure, "delete" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "foo"
    list [catch {.m1 delete 1 0} msg] $msg [destroy .m1] 
} {0 {} {}}
test menu-3.27 {MenuWidgetCmd procedure, "delete" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "1"
    .m1 add command -label "2"
    .m1 add command -label "3"
    list [catch {.m1 delete 1 3} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.28 {MenuWidgetCmd procedure, "delete" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "1"
    .m1 add command -label "2"
    .m1 add command -label "3"
    .m1 activate 2
    list [catch {.m1 delete 1 3} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.29 {MenuWidgetCmd procedure, "delete" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "1"
    .m1 add command -label "2"
    .m1 add command -label "3"
    .m1 activate 3
    list [catch {.m1 delete 1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.30 {MenuWidgetCmd procedure, "entrycget" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 entrycget} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 entrycget index option"} {}}
test menu-3.31 {MenuWidgetCmd procedure, "entrycget" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 entrycget index option foo} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 entrycget index option"} {}}
test menu-3.32 {MenuWidgetCmd procedure, "entrycget" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 entrycget foo -label} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
test menu-3.33 {MenuWidgetCmd procedure, "entrycget" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
} {0 test {}}
test menu-3.34 {MenuWidgetCmd procedure, "entryconfigure" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 entryconfigure} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 entryconfigure index ?option value ...?"} {}}
test menu-3.35 {MenuWidgetCmd procedure, "entryconfigure" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 entryconfigure foo} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
test menu-3.36 {MenuWidgetCmd procedure, "entryconfigure" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {llength [.m1 entryconfigure 1]} msg] $msg [destroy .m1]
} {0 14 {}}
test menu-3.37 {MenuWidgetCmd procedure, "entryconfigure" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1]
} {0 test {}}
test menu-3.38 {MenuWidgetCmd procedure, "entryconfigure" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 entryconfigure 1 -label "changed"
    list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1]
} {0 changed {}}
test menu-3.39 {MenuWidgetCmd procedure, "index" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 index} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 index string"} {}}
test menu-3.40 {MenuWidgetCmd procedure, "index" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 index foo} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
test menu-3.41 {MenuWidgetCmd procedure, "index" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 index "test"} msg] $msg [destroy .m1]
} {0 1 {}}
test menu-3.42 {MenuWidgetCmd procedure, "insert" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 insert} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 insert index type ?options?"} {}}
test menu-3.43 {MenuWidgetCmd procedure, "insert" option} {
    catch {destroy .m1}
    menu .m1
    .m1 insert 1 command -label "test"
    list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
} {0 test {}}
test menu-3.44 {MenuWidgetCmd procedure, "invoke" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 invoke} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 invoke index"} {}}
test menu-3.45 {MenuWidgetCmd procedure, "invoke" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 invoke foo} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
test menu-3.46 {MenuWidgetCmd procedure, "invoke" option} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add command -label "set foo" -command "set foo hello"
    list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 hello 0 hello 0 {} {}}
test menu-3.47 {MenuWidgetCmd procedure, "post" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "On Windows, hit Escape to get this menu to go away"
    list [catch {.m1 post} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 post x y"} {}}
test menu-3.48 {MenuWidgetCmd procedure, "post" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 post foo 40} msg] $msg [destroy .m1]
} {1 {expected integer but got "foo"} {}}
test menu-3.49 {MenuWidgetCmd procedure, "post" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 post 40 bar} msg] $msg [destroy .m1]
} {1 {expected integer but got "bar"} {}}
test menu-3.50 {MenuWidgetCmd procedure, "post" option} {menuInteractive} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "menu-3.53: hit Escape" -command "puts hello"
    list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.51 {MenuWidgetCmd procedure, "postcascade" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 postcascade} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 postcascade index"} {}}
test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} {
    catch {destroy .m1}