1########################################################################## 2# TEPAM - Tcl's Enhanced Procedure and Argument Manager 3########################################################################## 4# 5# proc_interactive.test: 6# This file is part of the enhanced procedure and argument manager's regression 7# test. It validates the interactive procedure calls for the different data and 8# widget types. 9# 10# Copyright (C) 2009, 2010 Andreas Drollinger 11# 12# RCS: @(#) $Id: proc_interactive.test,v 1.1 2010/02/11 21:50:55 droll Exp $ 13########################################################################## 14# See the file "license.terms" for information on usage and redistribution 15# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 16########################################################################## 17 18source [file join \ 19 [file dirname [file dirname [file join [pwd] [info script]]]] \ 20 devtools testutilities.tcl] 21 22testsNeedTcl 8.3 23testsNeedTcltest 1.0 24 25catch {namespace delete ::tepam} 26testing { 27 useLocal tepam.tcl tepam 28} 29 30namespace import tepam::* 31package require Tk 32 33######## Check the default values ######## 34 35# Evaluate the default font name. Use the 'font actual' command to evaluate the real font 36# names (Tk8.5 uses pseudo font names like 'TkDefaultFont'). 37set DefaultFontOrig [[label .lfont] cget -font] 38set DefaultFont [list [font actual $DefaultFontOrig -family] \ 39 [expr [font actual $DefaultFontOrig -size]<6 ? 6 : [font actual $DefaultFontOrig -size]]] 40 41 # Procedure declaration 42 43 set tepam::interactive_display_format short 44 45 procedure AllTypeProcedure1Default { 46 -args { 47 {-untyped -default UNTYPED} 48 {-untyped2 -type "" -default UNTYPED2} 49 {-string -type string -default STRING} 50 {-integer -type integer -default 1234} 51 {-alnum -type alnum -default ALNUM} 52 {-alpha -type alpha -default ALPHA} 53 {-ascii -type ascii -default ASCII} 54 {-control -type control -default "\t"} 55 {-boolean -type boolean -default 0} 56 {-digit -type digit -default 9876} 57 {-double -type double -default 1.234} 58 {-graph -type graph -default GRAPH} 59 {-lower -type lower -default lower} 60 {-print -type print -default PRINT} 61 {-punct -type punct -default ..,.} 62 {-space -type space -default " "} 63 {-upper -type upper -default UPPER} 64 {-wordchar -type wordchar -default WORDCHAR} 65 {-xdigit -type xdigit -default 1234ABCD} 66 {-color -type color -default blue} 67 {-font -type font -default {Arial 13}} 68 {-file -type file -default test_file.log} 69 {-directory -type directory -default my_dir} 70 71 {-integer2 -type integer -choices {1 2 3} -default 2} 72 {-integer3 -type integer -multiple -choices {1 2 3 4 5 6 7 8 9} -default 4} 73 {-none1 -type none -default 0} 74 {-none2 -type none -default 1} 75 } 76 } { 77 set res "Arguments - " 78 append res "untyped:'$untyped' " 79 append res "untyped2:'$untyped2' " 80 append res "string:'$string' " 81 append res "integer:'$integer' " 82 append res "alnum:'$alnum' " 83 append res "alpha:'$alpha' " 84 append res "ascii:'$ascii' " 85 append res "control:'$control' " 86 append res "boolean:'$boolean' " 87 append res "digit:'$digit' " 88 append res "double:'$double' " 89 append res "graph:'$graph' " 90 append res "lower:'$lower' " 91 append res "print:'$print' " 92 append res "punct:'$punct' " 93 append res "space:'$space' " 94 append res "upper:'$upper' " 95 append res "wordchar:'$wordchar' " 96 append res "xdigit:'$xdigit' " 97 append res "color:'$color' " 98 append res "font:'$font' " 99 append res "file:'$file' " 100 append res "directory:'$directory' " 101 102 append res "integer2:'$integer2' " 103 append res "integer3:'$integer3' " 104 append res "none1:'$none1' " 105 append res "none2:'$none2' " 106 107 return $res 108 } 109 110 # Call the procedure without providing any argument. This creates the reference result: 111 set ReferenceDefaultString [AllTypeProcedure1Default] 112 113 # Call the procedure interactively, emulate the activation of the "Cancel" button: 114 set tepam::argument_dialogbox(test,status) cancel 115 116 test tepam-proc.int-call-default.cancel "tepam, interactive procedure call - cancel" \ 117 -body {set InteractiveCancelString [AllTypeProcedure1Default -interactive]} \ 118 -result "" -output "" -match exact 119 120 # Call the procedure interactively, emulate the activation of the "OK" button: 121 set tepam::argument_dialogbox(test,status) ok 122 123 # Call the procedure interactively and check that a result is returned 124 test tepam-proc.int-call-default.ok "tepam, interactive procedure call - ok " \ 125 -body {set InteractiveDefaultString [AllTypeProcedure1Default -interactive]} \ 126 -result "Arguments - *" -output "" -match glob 127 128 # Check now all parts of the previous result string 129 130 foreach {Type Default} { 131 untyped UNTYPED 132 untyped2 UNTYPED2 133 string STRING 134 integer 1234 135 alnum ALNUM 136 alpha ALPHA 137 ascii ASCII 138 control "\t" 139 boolean 0 140 digit 9876 141 double 1.234 142 graph GRAPH 143 lower lower 144 print PRINT 145 punct ..,. 146 space " " 147 upper UPPER 148 wordchar WORDCHAR 149 xdigit 1234ABCD 150 color blue 151 font {Arial 13} 152 file test_file.log 153 directory my_dir 154 155 integer2 2 156 integer3 4 157 none1 0 158 none2 1 159 } { 160 test tepam-proc.int-call.default.$Type "tepam, interactive procedure call - $Type" \ 161 -body {set InteractiveDefaultString} \ 162 -result "* $Type:'$Default' *" -match glob 163 } 164 165######## Check each data type individually ######## 166 167 # Procedure declaration 168 169 set tepam::interactive_display_format short 170 171 procedure AllTypeProcedure2 { 172 -args { 173 {-untyped -optional} 174 {-untyped2 -type "" -optional} 175 {-string -type string -optional} 176 {-integer -type integer -optional} 177 {-alnum -type alnum -optional} 178 {-alpha -type alpha -optional} 179 {-ascii -type ascii -optional} 180 {-control -type control -optional} 181 {-boolean -type boolean -optional} 182 {-digit -type digit -optional} 183 {-double -type double -optional} 184 {-graph -type graph -optional} 185 {-lower -type lower -optional} 186 {-print -type print -optional} 187 {-punct -type punct -optional} 188 {-space -type space -optional} 189 {-upper -type upper -optional} 190 {-wordchar -type wordchar -optional} 191 {-xdigit -type xdigit -optional} 192 {-color -type color -optional} 193 {-font -type font -optional} 194 {-file -type file -optional} 195 {-directory -type directory -optional} 196 197 {-integer2 -type integer -choices {1 2 3} -optional} 198 {-integer3 -type integer -multiple -choices {1 2 3 4 5 6 7 8 9} -optional} 199 {-none -type none -optional} 200 } 201 } { 202 set res "" 203 catch {append res " untyped:'$untyped'"} 204 catch {append res " untyped2:'$untyped2'"} 205 catch {append res " string:'$string'"} 206 catch {append res " integer:'$integer'"} 207 catch {append res " alnum:'$alnum'"} 208 catch {append res " alpha:'$alpha'"} 209 catch {append res " ascii:'$ascii'"} 210 catch {append res " control:'$control'"} 211 catch {append res " boolean:'$boolean'"} 212 catch {append res " digit:'$digit'"} 213 catch {append res " double:'$double'"} 214 catch {append res " graph:'$graph'"} 215 catch {append res " lower:'$lower'"} 216 catch {append res " print:'$print'"} 217 catch {append res " punct:'$punct'"} 218 catch {append res " space:'$space'"} 219 catch {append res " upper:'$upper'"} 220 catch {append res " wordchar:'$wordchar'"} 221 catch {append res " xdigit:'$xdigit'"} 222 catch {append res " color:'$color'"} 223 catch {append res " file:'$file'"} 224 catch {append res " directory:'$directory'"} 225 226 catch {append res " integer3:'$integer3'"} 227 228 catch {append res " font:'$font'"} 229 catch {append res " integer2:'$integer2'"} 230 catch {append res " none:'$none'"} 231 232 return [string range $res 1 end] 233 } 234 235 # Call the procedure interactively, emulate the activation of the "Cancel" button: 236 set tepam::argument_dialogbox(test,status) cancel 237 238 test tepam-proc.int-call.cancel "tepam, interactive procedure call - cancel" \ 239 -body {set InteractiveCancelString [AllTypeProcedure2 -interactive]} \ 240 -result "" -output "" -match exact 241 242 # Call the procedure interactively, emulate the activation of the "OK" button: 243 set tepam::argument_dialogbox(test,status) ok 244 245 # Call the procedure interactively and check that an empty result is returned 246 test tepam-proc.int-call.ok "tepam, interactive procedure call - ok" \ 247 -body {AllTypeProcedure2 -interactive} \ 248 -result "font:'$DefaultFont' integer2:'1' none:'0'" -output "" -match exact 249 250 # Check now all parts of the previous result string 251 252 set ArgPos 2 253 foreach {Type Value} { 254 untyped UNTYPED 255 untyped2 UNTYPED2 256 string STRING 257 integer 1234 258 alnum ALNUM 259 alpha ALPHA 260 ascii ASCII 261 control "\t" 262 boolean 0 263 digit 9876 264 double 1.234 265 graph GRAPH 266 lower lower 267 print PRINT 268 punct ..,. 269 space " " 270 upper UPPER 271 wordchar WORDCHAR 272 xdigit 1234ABCD 273 color blue 274 font {Arial 13} 275 file test_file.log 276 directory my_dir 277 278 integer2 2 279 integer3 4 280 none 1 281 } { 282 if {$Type=="integer2"} { 283 set EntryWidget "radiobox" 284 } elseif {$Type=="integer3"} { 285 set EntryWidget "disjointlistbox" 286 } elseif {$Type=="none"} { 287 set EntryWidget "checkbutton" 288 } elseif {[info procs ::tepam::ad_form($Type)]!=""} { 289 set EntryWidget $Type 290 } else { 291 set EntryWidget "entry" 292 } 293 294 switch $Type { 295 "font" {set Result "$Type:'$Value' integer2:'1' none:'0'"} 296 "integer2" {set Result "font:'$DefaultFont' $Type:'$Value' none:'0'"} 297 "none" {set Result "font:'$DefaultFont' integer2:'1' $Type:'$Value'"} 298 default {set Result "$Type:'$Value' font:'$DefaultFont' integer2:'1' none:'0'"} 299 } 300 301 # Change the value and check that this value is returned: 302 set tepam::argument_dialogbox(test,script) "ad_form($EntryWidget) \$WChild($ArgPos).f set \"$Value\"" 303 set tepam::argument_dialogbox(test,status) ok 304 catch {array unset ::tepam::last_parameters} 305 306 test tepam-proc.int-call.$Type "tepam, interactive procedure call - $Type" \ 307 -body {AllTypeProcedure2 -interactive} \ 308 -result $Result -output "" -match exact 309 310# # Call the procedure again interactively, but keep the previous values: 311# set tepam::argument_dialogbox(test,script) "" 312# set tepam::argument_dialogbox(test,status) ok 313 314# test tepam-proc.int-recall.$Type "tepam, interactive procedure recall - $Type" \ 315# -body {AllTypeProcedure2 -interactive} \ 316# -result $Result -output "" -match exact 317 318 incr ArgPos 319 } 320 321######## Check each entry widget individually with and without default value ######## 322 323 foreach {name wtype default setvalue getvalue procargs} { 324 entry0 entry {} {"abcd"} {abcd} {} 325 entry1 entry {123} {"abcd"} {abcd} {-default 123} 326 327 checkbx0 checkbox {} {uline} {uline} {-multiple -choices {bold ital uline}} 328 checkbx1 checkbox {ital} {uline} {uline} {-multiple -choices {bold ital uline} -default ital} 329 checkbx2 checkbox {ital uline} {uline} {uline} {-multiple -choices {bold ital uline} -default {ital uline}} 330 331 radiobx0 radiobox {bold} {uline} {uline} {-choices {bold ital uline}} 332 radiobx1 radiobox {ital} {uline} {uline} {-choices {bold ital uline} -default ital} 333 334 chkbttn0 checkbutton {0} {1} {1} {-type none} 335 chkbttn1 checkbutton {1} {0} {0} {-type none -default 1} 336 337 listbx0 listbox {1} {4} {4} {-choices {1 2 3 4 5 6 7 8}} 338 listbx1 listbox {5} {4} {4} {-choices {1 2 3 4 5 6 7 8} -default 5} 339 340 djlistbx0 disjointlistbox {} "{4 6 8}" {4 6 8} {-multiple -choices {1 2 3 4 5 6 7 8}} 341 djlistbx0 disjointlistbox {2 3} "{4 6 8}" {4 6 8} {-multiple -choices {1 2 3 4 5 6 7 8} -default {2 3}} 342 343 file1 file {b.log} {a.log} {a.log} {-type file -default b.log} 344 dir1 directory {mydir} {yourdir} {yourdir} {-type directory -default mydir} 345 color1 color {red} {blue} {blue} {-type color -default red} 346 font1 font {Courier 10} "{Arial 12}" {Arial 12} {-type font -default {Courier 10}} 347 } { 348 349 # Procedure declaration 350 set tepam::interactive_display_format short 351 352 procedure test_proc__$name "-args \{ \{par $procargs\} \}" { 353 return "$par" 354 } 355 356 # Accept just the default values 357 set tepam::argument_dialogbox(test,script) "" 358 set tepam::argument_dialogbox(test,status) ok 359 catch {array unset ::tepam::last_parameters} 360 361 test tepam-proc.int-call.$name.default "tepam, interactive procedure call - $name default" \ 362 -body {test_proc__$name -interactive} \ 363 -result "$default" -output "" -match exact 364 365 # Change the values and check that this value is returned: 366 set tepam::argument_dialogbox(test,script) "ad_form($wtype) \$WChild(2).f set $setvalue; " 367 set tepam::argument_dialogbox(test,status) ok 368 369 test tepam-proc.int-call.$name.change "tepam, interactive procedure call - $name change" \ 370 -body {test_proc__$name -interactive} \ 371 -result "$getvalue" -output "" -match exact 372 373 # Call the procedure again interactively, but keep the previous values: 374 set tepam::argument_dialogbox(test,script) "" 375 set tepam::argument_dialogbox(test,status) ok 376 377 test tepam-proc.int-call.$name.ok "tepam, interactive procedure call - $name OK" \ 378 -body {test_proc__$name -interactive} \ 379 -result "$getvalue" -output "" -match exact 380 } 381 382######## That's all ######## 383 384destroy .lfont; # Remove again the label widget to evaluate the default font 385::tcltest::cleanupTests 386return 387 388########################################################################## 389# $RCSfile: proc_interactive.test,v $ - ($Name: $) 390# $Id: proc_interactive.test,v 1.1 2010/02/11 21:50:55 droll Exp $ 391# Modifications: 392# $Log: proc_interactive.test,v $ 393# Revision 1.1 2010/02/11 21:50:55 droll 394# TEPAM module checkin 395# 396########################################################################## 397 398