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