1# This file is a Tcl script to test out the option-handling facilities 2# of Tk. It is organized in the standard fashion for Tcl tests. 3# 4# Copyright (c) 1991-1993 The Regents of the University of California. 5# Copyright (c) 1994 Sun Microsystems, Inc. 6# Copyright (c) 1998-1999 by Scriptics Corporation. 7# All rights reserved. 8# 9# RCS: @(#) $Id$ 10 11package require tcltest 2.1 12eval tcltest::configure $argv 13tcltest::loadTestedCommands 14 15testConstraint appNameIsTktest [expr {[winfo name .] eq "tktest"}] 16 17catch {destroy .op1} 18catch {destroy .op2} 19set appName [winfo name .] 20 21# First, test basic retrievals, being sure to trigger all the various 22# types of NodeElements (EXACT_LEAF_NAME, WILDCARD_NODE_CLASS, and 23# everything in-between). 24 25frame .op1 -class Class1 26frame .op2 -class Class2 27frame .op1.op3 -class Class1 28frame .op1.op4 -class Class3 29frame .op2.op5 -class Class2 30frame .op1.op3.op6 -class Class4 31 32option clear 33option add *Color1 red 34option add *x blue 35option add *Class1.x yellow 36option add $appName.op1.x green 37option add *Class2.Color1 orange 38option add $appName.op2.op5.Color2 purple 39option add $appName.Class1.Class3.y brown 40option add $appName*op6*Color2 black 41option add $appName*Class1.op1.Color2 grey 42 43test option-1.1 {basic option retrieval} {option get . x Color1} blue 44test option-1.2 {basic option retrieval} {option get . y Color1} red 45test option-1.3 {basic option retrieval} {option get . z Color1} red 46test option-1.4 {basic option retrieval} {option get . x Color2} blue 47test option-1.5 {basic option retrieval} {option get . y Color2} {} 48test option-1.6 {basic option retrieval} {option get . z Color2} {} 49 50test option-2.1 {basic option retrieval} {option get .op1 x Color1} green 51test option-2.2 {basic option retrieval} {option get .op1 y Color1} red 52test option-2.3 {basic option retrieval} {option get .op1 z Color1} red 53test option-2.4 {basic option retrieval} {option get .op1 x Color2} green 54test option-2.5 {basic option retrieval} {option get .op1 y Color2} {} 55test option-2.6 {basic option retrieval} {option get .op1 z Color2} {} 56 57test option-3.1 {basic option retrieval} {option get .op1.op3 x Color1} yellow 58test option-3.2 {basic option retrieval} {option get .op1.op3 y Color1} red 59test option-3.3 {basic option retrieval} {option get .op1.op3 z Color1} red 60test option-3.4 {basic option retrieval} {option get .op1.op3 x Color2} yellow 61test option-3.5 {basic option retrieval} {option get .op1.op3 y Color2} {} 62test option-3.6 {basic option retrieval} {option get .op1.op3 z Color2} {} 63 64test option-4.1 {basic option retrieval} {option get .op1.op3.op6 x Color1} blue 65test option-4.2 {basic option retrieval} {option get .op1.op3.op6 y Color1} red 66test option-4.3 {basic option retrieval} {option get .op1.op3.op6 z Color1} red 67test option-4.4 {basic option retrieval} {option get .op1.op3.op6 x Color2} black 68test option-4.5 {basic option retrieval} {option get .op1.op3.op6 y Color2} black 69test option-4.6 {basic option retrieval} {option get .op1.op3.op6 z Color2} black 70 71test option-5.1 {basic option retrieval} {option get .op1.op4 x Color1} blue 72test option-5.2 {basic option retrieval} {option get .op1.op4 y Color1} brown 73test option-5.3 {basic option retrieval} {option get .op1.op4 z Color1} red 74test option-5.4 {basic option retrieval} {option get .op1.op4 x Color2} blue 75test option-5.5 {basic option retrieval} {option get .op1.op4 y Color2} brown 76test option-5.6 {basic option retrieval} {option get .op1.op4 z Color2} {} 77 78test option-6.1 {basic option retrieval} {option get .op2 x Color1} orange 79test option-6.2 {basic option retrieval} {option get .op2 y Color1} orange 80test option-6.3 {basic option retrieval} {option get .op2 z Color1} orange 81test option-6.4 {basic option retrieval} {option get .op2 x Color2} blue 82test option-6.5 {basic option retrieval} {option get .op2 y Color2} {} 83test option-6.6 {basic option retrieval} {option get .op2 z Color2} {} 84 85test option-7.1 {basic option retrieval} {option get .op2.op5 x Color1} orange 86test option-7.2 {basic option retrieval} {option get .op2.op5 y Color1} orange 87test option-7.3 {basic option retrieval} {option get .op2.op5 z Color1} orange 88test option-7.4 {basic option retrieval} {option get .op2.op5 x Color2} purple 89test option-7.5 {basic option retrieval} {option get .op2.op5 y Color2} purple 90test option-7.6 {basic option retrieval} {option get .op2.op5 z Color2} purple 91 92# Now try similar tests to above, except jump around non-hierarchically 93# between windows to make sure that the option stacks are pushed and 94# popped correctly. 95 96option get . foo Foo 97test option-8.1 {stack pushing/popping} {option get .op2.op5 x Color1} orange 98test option-8.2 {stack pushing/popping} {option get .op2.op5 y Color1} orange 99test option-8.3 {stack pushing/popping} {option get .op2.op5 z Color1} orange 100test option-8.4 {stack pushing/popping} {option get .op2.op5 x Color2} purple 101test option-8.5 {stack pushing/popping} {option get .op2.op5 y Color2} purple 102test option-8.6 {stack pushing/popping} {option get .op2.op5 z Color2} purple 103 104test option-9.1 {stack pushing/popping} {option get . x Color1} blue 105test option-9.2 {stack pushing/popping} {option get . y Color1} red 106test option-9.3 {stack pushing/popping} {option get . z Color1} red 107test option-9.4 {stack pushing/popping} {option get . x Color2} blue 108test option-9.5 {stack pushing/popping} {option get . y Color2} {} 109test option-9.6 {stack pushing/popping} {option get . z Color2} {} 110 111test option-10.1 {stack pushing/popping} {option get .op1.op3.op6 x Color1} blue 112test option-10.2 {stack pushing/popping} {option get .op1.op3.op6 y Color1} red 113test option-10.3 {stack pushing/popping} {option get .op1.op3.op6 z Color1} red 114test option-10.4 {stack pushing/popping} {option get .op1.op3.op6 x Color2} black 115test option-10.5 {stack pushing/popping} {option get .op1.op3.op6 y Color2} black 116test option-10.6 {stack pushing/popping} {option get .op1.op3.op6 z Color2} black 117 118test option-11.1 {stack pushing/popping} {option get .op1.op3 x Color1} yellow 119test option-11.2 {stack pushing/popping} {option get .op1.op3 y Color1} red 120test option-11.3 {stack pushing/popping} {option get .op1.op3 z Color1} red 121test option-11.4 {stack pushing/popping} {option get .op1.op3 x Color2} yellow 122test option-11.5 {stack pushing/popping} {option get .op1.op3 y Color2} {} 123test option-11.6 {stack pushing/popping} {option get .op1.op3 z Color2} {} 124 125test option-12.1 {stack pushing/popping} {option get .op1 x Color1} green 126test option-12.2 {stack pushing/popping} {option get .op1 y Color1} red 127test option-12.3 {stack pushing/popping} {option get .op1 z Color1} red 128test option-12.4 {stack pushing/popping} {option get .op1 x Color2} green 129test option-12.5 {stack pushing/popping} {option get .op1 y Color2} {} 130test option-12.6 {stack pushing/popping} {option get .op1 z Color2} {} 131 132# Test the major priority levels (widgetDefault, etc.) 133 134option add $appName.op1.a 100 100 135option add $appName.op1.A interactive interactive 136option add $appName.op1.b userDefault userDefault 137option add $appName.op1.B startupFile startupFile 138option add $appName.op1.c widgetDefault widgetDefault 139option add $appName.op1.C 0 0 140 141test option-13.1 {priority levels} {option get .op1 a A} 100 142test option-13.2 {priority levels} {option get .op1 b A} interactive 143test option-13.3 {priority levels} {option get .op1 b B} userDefault 144test option-13.4 {priority levels} {option get .op1 c B} startupFile 145test option-13.5 {priority levels} {option get .op1 c C} widgetDefault 146option add $appName.op1.B file2 widget 147test option-13.6 {priority levels} {option get .op1 c B} startupFile 148option add $appName.op1.B file2 startupFile 149test option-13.7 {priority levels} {option get .op1 c B} file2 150 151# Test various error conditions 152 153test option-14.1 {error conditions} { 154 list [catch {option} msg] $msg 155} {1 {wrong # args: should be "option cmd arg ?arg ...?"}} 156test option-14.2 {error conditions} { 157 list [catch {option x} msg] $msg 158} {1 {bad option "x": must be add, clear, get, or readfile}} 159test option-14.3 {error conditions} { 160 list [catch {option foo 3} msg] $msg 161} {1 {bad option "foo": must be add, clear, get, or readfile}} 162test option-14.4 {error conditions} { 163 list [catch {option add 3} msg] $msg 164} {1 {wrong # args: should be "option add pattern value ?priority?"}} 165test option-14.5 {error conditions} { 166 list [catch {option add . a b c} msg] $msg 167} {1 {wrong # args: should be "option add pattern value ?priority?"}} 168test option-14.6 {error conditions} { 169 list [catch {option add . a -1} msg] $msg 170} {1 {bad priority level "-1": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}} 171test option-14.7 {error conditions} { 172 list [catch {option add . a 101} msg] $msg 173} {1 {bad priority level "101": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}} 174test option-14.8 {error conditions} { 175 list [catch {option add . a gorp} msg] $msg 176} {1 {bad priority level "gorp": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}} 177test option-14.9 {error conditions} { 178 list [catch {option get 3} msg] $msg 179} {1 {wrong # args: should be "option get window name class"}} 180test option-14.10 {error conditions} { 181 list [catch {option get 3 4} msg] $msg 182} {1 {wrong # args: should be "option get window name class"}} 183test option-14.11 {error conditions} { 184 list [catch {option get 3 4 5 6} msg] $msg 185} {1 {wrong # args: should be "option get window name class"}} 186test option-14.12 {error conditions} { 187 list [catch {option get .gorp.gorp a A} msg] $msg 188} {1 {bad window path name ".gorp.gorp"}} 189 190set option1 [file join [testsDirectory] option.file1] 191set option2 [file join [testsDirectory] option.file2] 192 193test option-15.1 {database files} { 194 list [catch {option read non-existent} msg] $msg 195} {1 {couldn't open "non-existent": no such file or directory}} 196option read $option1 197test option-15.2 {database files} {option get . x1 color} blue 198test option-15.3 {database files} appNameIsTktest {option get . x2 color} green 199test option-15.4 {database files} {option get . x3 color} purple 200test option-15.5 {database files} {option get . {x 4} color} brown 201test option-15.6 {database files} {option get . x6 color} {} 202test option-15.7 {database files} { 203 list [catch {option read $option1 widget foo} msg] $msg 204} {1 {wrong # args: should be "option readfile fileName ?priority?"}} 205option add *x3 burgundy 206catch {option read $option1 userDefault} 207test option-15.8 {database files} {option get . x3 color} burgundy 208test option-15.9 {database files} { 209 list [catch {option read $option2} msg] $msg 210} {1 {missing colon on line 2}} 211 212test option-16.1 {ReadOptionFile} { 213 set option3 [makeFile {} option.file3] 214 set file [open $option3 w] 215 fconfigure $file -translation crlf 216 puts $file "*x7: true\n*x8: false" 217 close $file 218 option read $option3 userDefault 219 set result [list [option get . x7 color] [option get . x8 color]] 220 removeFile $option3 221 set result 222} {true false} 223 224catch {destroy .op1} 225catch {destroy .op2} 226 227# cleanup 228cleanupTests 229return 230