223 lines
11 KiB
Plaintext
223 lines
11 KiB
Plaintext
# This file is a Tcl script to test out the option-handling facilities
|
|
# of Tk. It is organized in the standard fashion for Tcl tests.
|
|
#
|
|
# Copyright (c) 1991-1993 The Regents of the University of California.
|
|
# Copyright (c) 1994 Sun Microsystems, Inc.
|
|
#
|
|
# See the file "license.terms" for information on usage and redistribution
|
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
#
|
|
# SCCS: @(#) option.test 1.17 96/05/01 14:52:48
|
|
|
|
if {[string compare test [info procs test]] == 1} then \
|
|
{source defs}
|
|
|
|
catch {destroy .op1}
|
|
catch {destroy .op2}
|
|
set appName [winfo name .]
|
|
|
|
# First, test basic retrievals, being sure to trigger all the various
|
|
# types of NodeElements (EXACT_LEAF_NAME, WILDCARD_NODE_CLASS, and
|
|
# everything in-between).
|
|
|
|
frame .op1 -class Class1
|
|
frame .op2 -class Class2
|
|
frame .op1.op3 -class Class1
|
|
frame .op1.op4 -class Class3
|
|
frame .op2.op5 -class Class2
|
|
frame .op1.op3.op6 -class Class4
|
|
|
|
option clear
|
|
option add *Color1 red
|
|
option add *x blue
|
|
option add *Class1.x yellow
|
|
option add $appName.op1.x green
|
|
option add *Class2.Color1 orange
|
|
option add $appName.op2.op5.Color2 purple
|
|
option add $appName.Class1.Class3.y brown
|
|
option add $appName*op6*Color2 black
|
|
option add $appName*Class1.op1.Color2 grey
|
|
|
|
test option-1.1 {basic option retrieval} {option get . x Color1} blue
|
|
test option-1.2 {basic option retrieval} {option get . y Color1} red
|
|
test option-1.3 {basic option retrieval} {option get . z Color1} red
|
|
test option-1.4 {basic option retrieval} {option get . x Color2} blue
|
|
test option-1.5 {basic option retrieval} {option get . y Color2} {}
|
|
test option-1.6 {basic option retrieval} {option get . z Color2} {}
|
|
|
|
test option-2.1 {basic option retrieval} {option get .op1 x Color1} green
|
|
test option-2.2 {basic option retrieval} {option get .op1 y Color1} red
|
|
test option-2.3 {basic option retrieval} {option get .op1 z Color1} red
|
|
test option-2.4 {basic option retrieval} {option get .op1 x Color2} green
|
|
test option-2.5 {basic option retrieval} {option get .op1 y Color2} {}
|
|
test option-2.6 {basic option retrieval} {option get .op1 z Color2} {}
|
|
|
|
test option-3.1 {basic option retrieval} {option get .op1.op3 x Color1} yellow
|
|
test option-3.2 {basic option retrieval} {option get .op1.op3 y Color1} red
|
|
test option-3.3 {basic option retrieval} {option get .op1.op3 z Color1} red
|
|
test option-3.4 {basic option retrieval} {option get .op1.op3 x Color2} yellow
|
|
test option-3.5 {basic option retrieval} {option get .op1.op3 y Color2} {}
|
|
test option-3.6 {basic option retrieval} {option get .op1.op3 z Color2} {}
|
|
|
|
test option-4.1 {basic option retrieval} {option get .op1.op3.op6 x Color1} blue
|
|
test option-4.2 {basic option retrieval} {option get .op1.op3.op6 y Color1} red
|
|
test option-4.3 {basic option retrieval} {option get .op1.op3.op6 z Color1} red
|
|
test option-4.4 {basic option retrieval} {option get .op1.op3.op6 x Color2} black
|
|
test option-4.5 {basic option retrieval} {option get .op1.op3.op6 y Color2} black
|
|
test option-4.6 {basic option retrieval} {option get .op1.op3.op6 z Color2} black
|
|
|
|
test option-5.1 {basic option retrieval} {option get .op1.op4 x Color1} blue
|
|
test option-5.2 {basic option retrieval} {option get .op1.op4 y Color1} brown
|
|
test option-5.3 {basic option retrieval} {option get .op1.op4 z Color1} red
|
|
test option-5.4 {basic option retrieval} {option get .op1.op4 x Color2} blue
|
|
test option-5.5 {basic option retrieval} {option get .op1.op4 y Color2} brown
|
|
test option-5.6 {basic option retrieval} {option get .op1.op4 z Color2} {}
|
|
|
|
test option-6.1 {basic option retrieval} {option get .op2 x Color1} orange
|
|
test option-6.2 {basic option retrieval} {option get .op2 y Color1} orange
|
|
test option-6.3 {basic option retrieval} {option get .op2 z Color1} orange
|
|
test option-6.4 {basic option retrieval} {option get .op2 x Color2} blue
|
|
test option-6.5 {basic option retrieval} {option get .op2 y Color2} {}
|
|
test option-6.6 {basic option retrieval} {option get .op2 z Color2} {}
|
|
|
|
test option-7.1 {basic option retrieval} {option get .op2.op5 x Color1} orange
|
|
test option-7.2 {basic option retrieval} {option get .op2.op5 y Color1} orange
|
|
test option-7.3 {basic option retrieval} {option get .op2.op5 z Color1} orange
|
|
test option-7.4 {basic option retrieval} {option get .op2.op5 x Color2} purple
|
|
test option-7.5 {basic option retrieval} {option get .op2.op5 y Color2} purple
|
|
test option-7.6 {basic option retrieval} {option get .op2.op5 z Color2} purple
|
|
|
|
# Now try similar tests to above, except jump around non-hierarchically
|
|
# between windows to make sure that the option stacks are pushed and
|
|
# popped correctly.
|
|
|
|
option get . foo Foo
|
|
test option-8.1 {stack pushing/popping} {option get .op2.op5 x Color1} orange
|
|
test option-8.2 {stack pushing/popping} {option get .op2.op5 y Color1} orange
|
|
test option-8.3 {stack pushing/popping} {option get .op2.op5 z Color1} orange
|
|
test option-8.4 {stack pushing/popping} {option get .op2.op5 x Color2} purple
|
|
test option-8.5 {stack pushing/popping} {option get .op2.op5 y Color2} purple
|
|
test option-8.6 {stack pushing/popping} {option get .op2.op5 z Color2} purple
|
|
|
|
test option-9.1 {stack pushing/popping} {option get . x Color1} blue
|
|
test option-9.2 {stack pushing/popping} {option get . y Color1} red
|
|
test option-9.3 {stack pushing/popping} {option get . z Color1} red
|
|
test option-9.4 {stack pushing/popping} {option get . x Color2} blue
|
|
test option-9.5 {stack pushing/popping} {option get . y Color2} {}
|
|
test option-9.6 {stack pushing/popping} {option get . z Color2} {}
|
|
|
|
test option-10.1 {stack pushing/popping} {option get .op1.op3.op6 x Color1} blue
|
|
test option-10.2 {stack pushing/popping} {option get .op1.op3.op6 y Color1} red
|
|
test option-10.3 {stack pushing/popping} {option get .op1.op3.op6 z Color1} red
|
|
test option-10.4 {stack pushing/popping} {option get .op1.op3.op6 x Color2} black
|
|
test option-10.5 {stack pushing/popping} {option get .op1.op3.op6 y Color2} black
|
|
test option-10.6 {stack pushing/popping} {option get .op1.op3.op6 z Color2} black
|
|
|
|
test option-11.1 {stack pushing/popping} {option get .op1.op3 x Color1} yellow
|
|
test option-11.2 {stack pushing/popping} {option get .op1.op3 y Color1} red
|
|
test option-11.3 {stack pushing/popping} {option get .op1.op3 z Color1} red
|
|
test option-11.4 {stack pushing/popping} {option get .op1.op3 x Color2} yellow
|
|
test option-11.5 {stack pushing/popping} {option get .op1.op3 y Color2} {}
|
|
test option-11.6 {stack pushing/popping} {option get .op1.op3 z Color2} {}
|
|
|
|
test option-12.1 {stack pushing/popping} {option get .op1 x Color1} green
|
|
test option-12.2 {stack pushing/popping} {option get .op1 y Color1} red
|
|
test option-12.3 {stack pushing/popping} {option get .op1 z Color1} red
|
|
test option-12.4 {stack pushing/popping} {option get .op1 x Color2} green
|
|
test option-12.5 {stack pushing/popping} {option get .op1 y Color2} {}
|
|
test option-12.6 {stack pushing/popping} {option get .op1 z Color2} {}
|
|
|
|
# Test the major priority levels (widgetDefault, etc.)
|
|
|
|
option add $appName.op1.a 100 100
|
|
option add $appName.op1.A interactive interactive
|
|
option add $appName.op1.b userDefault userDefault
|
|
option add $appName.op1.B startupFile startupFile
|
|
option add $appName.op1.c widgetDefault widgetDefault
|
|
option add $appName.op1.C 0 0
|
|
|
|
test option-13.1 {priority levels} {option get .op1 a A} 100
|
|
test option-13.2 {priority levels} {option get .op1 b A} interactive
|
|
test option-13.3 {priority levels} {option get .op1 b B} userDefault
|
|
test option-13.4 {priority levels} {option get .op1 c B} startupFile
|
|
test option-13.5 {priority levels} {option get .op1 c C} widgetDefault
|
|
option add $appName.op1.B file2 widget
|
|
test option-13.7 {priority levels} {option get .op1 c B} startupFile
|
|
option add $appName.op1.B file2 startupFile
|
|
test option-13.8 {priority levels} {option get .op1 c B} file2
|
|
|
|
# Test various error conditions
|
|
|
|
test option-14.1 {error conditions} {
|
|
list [catch {option} msg] $msg
|
|
} {1 {wrong # args: should be "option cmd arg ?arg ...?"}}
|
|
test option-14.2 {error conditions} {
|
|
list [catch {option x} msg] $msg
|
|
} {1 {bad option "x": must be add, clear, get, or readfile}}
|
|
test option-14.3 {error conditions} {
|
|
list [catch {option foo 3} msg] $msg
|
|
} {1 {bad option "foo": must be add, clear, get, or readfile}}
|
|
test option-14.4 {error conditions} {
|
|
list [catch {option add 3} msg] $msg
|
|
} {1 {wrong # args: should be "option add pattern value ?priority?"}}
|
|
test option-14.5 {error conditions} {
|
|
list [catch {option add . a b c} msg] $msg
|
|
} {1 {wrong # args: should be "option add pattern value ?priority?"}}
|
|
test option-14.6 {error conditions} {
|
|
list [catch {option add . a -1} msg] $msg
|
|
} {1 {bad priority level "-1": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
|
|
test option-14.7 {error conditions} {
|
|
list [catch {option add . a 101} msg] $msg
|
|
} {1 {bad priority level "101": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
|
|
test option-14.8 {error conditions} {
|
|
list [catch {option add . a gorp} msg] $msg
|
|
} {1 {bad priority level "gorp": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
|
|
test option-14.9 {error conditions} {
|
|
list [catch {option get 3} msg] $msg
|
|
} {1 {wrong # args: should be "option get window name class"}}
|
|
test option-14.10 {error conditions} {
|
|
list [catch {option get 3 4} msg] $msg
|
|
} {1 {wrong # args: should be "option get window name class"}}
|
|
test option-14.11 {error conditions} {
|
|
list [catch {option get 3 4 5 6} msg] $msg
|
|
} {1 {wrong # args: should be "option get window name class"}}
|
|
test option-14.12 {error conditions} {
|
|
list [catch {option get .gorp.gorp a A} msg] $msg
|
|
} {1 {bad window path name ".gorp.gorp"}}
|
|
|
|
test option-15.1 {database files} {
|
|
list [catch {option read non-existent} msg] $msg
|
|
} {1 {couldn't open "non-existent": no such file or directory}}
|
|
option read option.file1
|
|
test option-15.2 {database files} {option get . x1 color} blue
|
|
if {$appName == "tktest"} {
|
|
test option-15.3 {database files} {option get . x2 color} green
|
|
}
|
|
test option-15.4 {database files} {option get . x3 color} purple
|
|
test option-15.5 {database files} {option get . {x 4} color} brown
|
|
test option-15.5 {database files} {option get . x6 color} {}
|
|
test option-15.7 {database files} {
|
|
list [catch {option read option.file1 widget foo} msg] $msg
|
|
} {1 {wrong # args: should be "option readfile fileName ?priority?"}}
|
|
option add *x3 burgundy
|
|
catch {option read option.file1 userDefault}
|
|
test option-15.8 {database files} {option get . x3 color} burgundy
|
|
test option-15.9 {database files} {
|
|
list [catch {option read option.file2} msg] $msg
|
|
} {1 {missing colon on line 2}}
|
|
|
|
test option-16.1 {ReadOptionFile} {
|
|
set file [open "option.file3" w]
|
|
fconfigure $file -translation crlf
|
|
puts $file "*x7: true\n*x8: false"
|
|
close $file
|
|
option read option.file3 userDefault
|
|
set result [list [option get . x7 color] [option get . x8 color]]
|
|
removeFile option.file3
|
|
set result
|
|
} {true false}
|
|
|
|
catch {destroy .op1}
|
|
catch {destroy .op2}
|
|
concat {}
|