1##########################################################################
2# TEPAM - Tcl's Enhanced Procedure and Argument Manager
3##########################################################################
4#
5# proc_call_arg_type.test
6# This file is part of the enhanced procedure and argument manager's regression
7# test. It validates the declaration and call of the procedure sub commands.
8#
9# Copyright (C) 2009, 2010 Andreas Drollinger
10# 
11# RCS: @(#) $Id: proc_call_arg_type.test,v 1.1 2010/02/11 21:50:55 droll Exp $
12##########################################################################
13# See the file "license.terms" for information on usage and redistribution
14# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15##########################################################################
16
17source [file join \
18   [file dirname [file dirname [file join [pwd] [info script]]]] \
19   devtools testutilities.tcl]
20
21testsNeedTcl     8.3
22testsNeedTcltest 1.0
23
24catch {namespace delete ::tepam}
25testing {
26   useLocal tepam.tcl tepam
27}
28
29# Tests is an extension of the test command. It adds the option -variations that allows \
30# specifying a list values. For each of these values the test command is executed, replacing all '%1' 
31# of the original test command string by the altered value.
32proc tests {name description args} {
33   set VariationList(0) {""}; # Default variation list 0, in case no variations are required
34   for {set NbrVariationLists 0} {1} {incr NbrVariationLists} {
35      set VariationListPos [lsearch -exact $args -variations]
36      if {$VariationListPos<0} break
37      set VariationList($NbrVariationLists) [lindex $args [expr $VariationListPos+1]]
38      set args [lreplace $args $VariationListPos [expr $VariationListPos+1]]
39   }
40   for {set TestNbr 0} {$TestNbr<[llength $VariationList(0)]} {incr TestNbr} {
41      set TestExec "test \"$name\.$TestNbr\" \"$description.$TestNbr\""
42      foreach Arg $args {
43         set NewArg $Arg
44         for {set vl 0} {$vl<$NbrVariationLists} {incr vl} {
45            regsub -all "%[expr $vl+1]" $NewArg [lindex $VariationList($vl) $TestNbr] NewArg
46         }
47         append TestExec " \{$NewArg\}"
48      }
49      uplevel 1 $TestExec
50   }
51}
52
53######## Standard types ########
54   
55   tepam::procedure AllTypeProcedure {
56      -args {
57         {-untyped -optional}
58         {-untyped2 -type "" -optional}
59         {-string -type string -optional}
60         {-integer -type integer -optional}
61         {-alnum -type alnum -optional}
62         {-alpha -type alpha -optional}
63         {-ascii -type ascii -optional}
64         {-control -type control -optional}
65         {-boolean -type boolean -optional}
66         {-digit -type digit -optional}
67         {-double -type double -optional}
68         {-graph -type graph -optional}
69         {-lower -type lower -optional}
70         {-print -type print -optional}
71         {-punct -type punct -optional}
72         {-space -type space -optional}
73         {-upper -type upper -optional}
74         {-wordchar -type wordchar -optional}
75         {-xdigit -type xdigit -optional}
76         {-color -type color -optional}
77         {-font -type font -optional}
78      }
79   } {
80   }
81   
82      tests tepam-procargtype.sting "tepam, Procedure argument type check - String " \
83               -variations {0 12 3456789 a abcdefxyz ABCDXYZ .lkajs 98237().{} ==} \
84               -body "AllTypeProcedure -string   \"%1\"" \
85               -result "" -output ""
86      tests tepam-procargtype.int1 "tepam, Procedure argument type check - Integer 1" \
87               -variations { 0 1 2 9 10 11 01 0010 100 0x10 0xFF} \
88               -body "AllTypeProcedure -integer  \"%1\"" \
89               -result "" -output ""
90      tests tepam-procargtype.int2 "tepam, Procedure argument type check - Integer 2" \
91               -variations { "" " " a x 0x FF . , ?  0.123 1.123 1.2e2 1.3E-1} \
92               -body "AllTypeProcedure -integer  \"%1\"" \
93               -returnCodes error -result "*requires type 'integer'*" -output "" -match glob
94      tests tepam-procargtype.alnum1 "tepam, Procedure argument type check - Alnum 1" \
95               -variations { "" 0123456779 abcdefghijABCDEFGHIJ zZ} \
96               -body "AllTypeProcedure -alnum    \"%1\"" \
97               -result "" -output ""
98      tests tepam-procargtype.alnum2 "tepam, Procedure argument type check - Alnum 2" \
99               -variations { " " 1.123 _ ? . , = } \
100               -body "AllTypeProcedure -alnum    \"%1\"" \
101               -returnCodes error -result "*requires type 'alnum'*" -output "" -match glob
102      tests tepam-procargtype.ascii "tepam, Procedure argument type check - Ascii" \
103               -variations { abcdefghijklmnopqrstuvfxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 +*} \
104               -body "AllTypeProcedure -ascii    \"%1\"" \
105               -result "" -output ""
106      tests tepam-procargtype.bool1 "tepam, Procedure argument type check - Boolean 1" \
107               -variations { 0 1 TRUE FALSE true false} \
108               -body "AllTypeProcedure -boolean  \"%1\"" \
109               -result "" -output ""
110      tests tepam-procargtype.bool2 "tepam, Procedure argument type check - Boolean 2" \
111               -variations { "" " " 2 3 4 5 6 7 8 9 0xa 0xFF 1.123} \
112               -body "AllTypeProcedure -boolean  \"%1\"" \
113               -returnCodes error -result "*requires type 'boolean'*" -output "" -match glob
114      tests tepam-procargtype.digit1 "tepam, Procedure argument type check - Digit 1" \
115               -variations { "" 0 1 2 3 4 5 6 7 8 9 0123456789} \
116               -body "AllTypeProcedure -digit    \"%1\"" \
117               -result "" -output ""
118      tests tepam-procargtype.digit2 "tepam, Procedure argument type check - Digit 2" \
119               -variations { " " a b c d e f g h i j k l m n A B C D E F G H I J K L + g %} \
120               -body "AllTypeProcedure -digit    \"%1\"" \
121               -returnCodes error -result "*requires type 'digit'*" -output "" -match glob
122      tests tepam-procargtype.double1 "tepam, Procedure argument type check - Double 1" \
123               -variations { 0 1 4 10 100 0x100 0xFFFF 00123 0.0 0.1 1.123 23.456 1E-1 1.23e3} \
124               -body "AllTypeProcedure -double   \"%1\"" \
125               -result "" -output ""
126      tests tepam-procargtype.double2 "tepam, Procedure argument type check - Double 2" \
127               -variations { "" " " 0xFX1 a 12F ? .} \
128               -body "AllTypeProcedure -double   \"%1\"" \
129               -returnCodes error -result "*requires type 'double'*" -output "" -match glob
130      tests tepam-procargtype.lower1 "tepam, Procedure argument type check - Lower 1" \
131               -variations { "" adsf lkva oiuwwe myxy} \
132               -body "AllTypeProcedure -lower    \"%1\"" \
133               -result "" -output ""
134      tests tepam-procargtype.lower2 "tepam, Procedure argument type check - Lower 2" \
135               -variations { " " asXdf asd.f "_:;" a_a} \
136               -body "AllTypeProcedure -lower    \"%1\"" \
137               -returnCodes error -result "*requires type 'lower'*" -output "" -match glob
138      tests tepam-procargtype.space1 "tepam, Procedure argument type check - Space 1" \
139               -variations {"" " " "   "} \
140               -body "AllTypeProcedure -space \"%1\"" \
141               -result "" -output ""
142      tests tepam-procargtype.space2 "tepam, Procedure argument type check - Space 2" \
143               -variations { a lka 123 _ ? . , } \
144               -body "AllTypeProcedure -space    \"%1\"" \
145               -returnCodes error -result "*requires type 'space'*" -output "" -match glob
146      tests tepam-procargtype.upper1 "tepam, Procedure argument type check - Upper 1" \
147               -variations { "" A B CDEF GHIJKLMNO PQRSTUVWXYZ} \
148               -body "AllTypeProcedure -upper    \"%1\"" \
149               -result "" -output ""
150      tests tepam-procargtype.upper2 "tepam, Procedure argument type check - Upper 2" \
151               -variations { " " a b cde CD.EF GHI1KLMNO PQRSTuVWXYZ ? . , ) (} \
152               -body "AllTypeProcedure -upper    \"%1\"" \
153               -returnCodes error -result "*requires type 'upper'*" -output "" -match glob
154      tests tepam-procargtype.xdigit1 "tepam, Procedure argument type check - Xdigit 1" \
155               -variations { 0123456789abcdefABCDEF} \
156               -body "AllTypeProcedure -xdigit   \"%1\"" \
157               -result "" -output ""
158      tests tepam-procargtype.xdigit2 "tepam, Procedure argument type check - Xdigit 2" \
159               -variations { g h i x y z _ ? .} \
160               -returnCodes error -body "AllTypeProcedure -xdigit   \"%1\"" \
161               -result "*requires type 'xdigit'*" -output "" -match glob
162
163######## Standard types, multiple accepted arguments ########
164   
165   tepam::procedure AllTypeProcedure_Multiple {
166      -args {
167         {-untyped -optional -multiple}
168         {-untyped2 -type "" -optional}
169         {-string -type string -optional -multiple}
170         {-integer -type integer -optional -multiple}
171         {-alnum -type alnum -optional -multiple}
172         {-alpha -type alpha -optional -multiple}
173         {-ascii -type ascii -optional -multiple}
174         {-control -type control -optional -multiple}
175         {-boolean -type boolean -optional -multiple}
176         {-digit -type digit -optional -multiple}
177         {-double -type double -optional -multiple}
178         {-graph -type graph -optional -multiple}
179         {-lower -type lower -optional -multiple}
180         {-print -type print -optional -multiple}
181         {-punct -type punct -optional -multiple}
182         {-space -type space -optional -multiple}
183         {-upper -type upper -optional -multiple}
184         {-wordchar -type wordchar -optional -multiple}
185         {-xdigit -type xdigit -optional -multiple}
186         {-color -type color -optional -multiple}
187         {-font -type font -optional -multiple}
188      }
189   } {
190   }
191   
192      tests tepam-procargtype.string "tepam, Procedure argument type check - String" \
193               -variations { 0 12 3456789 a abcdefxyz ABCDXYZ .lkajs 98237().{} ==} \
194               -body "AllTypeProcedure_Multiple -string   \"%1\" -string \"%1\"" \
195               -result "" -output ""
196      tests tepam-procargtype.int1 "tepam, Procedure argument type check - Integer 1" \
197               -variations { 0 1 2 9 10 11 01 0010 100 0x10 0xFF} \
198               -body "AllTypeProcedure_Multiple -integer  \"%1\" -integer \"%1\"" \
199               -result "" -output ""
200      tests tepam-procargtype.int2 "tepam, Procedure argument type check - Integer 2" \
201               -variations { "" " " a x 0x FF . , ?  0.123 1.123 1.2e2 1.3E-1} \
202               -body "AllTypeProcedure_Multiple -integer  \"%1\" -integer \"%1\"" \
203               -returnCodes error -result "*requires type 'integer'*" -output "" -match glob
204      tests tepam-procargtype.alnum1 "tepam, Procedure argument type check - Alnum 1" \
205               -variations { "" 0123456779 abcdefghijABCDEFGHIJ zZ} \
206               -body "AllTypeProcedure_Multiple -alnum    \"%1\" -alnum \"%1\"" \
207               -result "" -output ""
208      tests tepam-procargtype.alnum2 "tepam, Procedure argument type check - Alnum2" \
209               -variations { " " 1.123 _ ? . , = } \
210               -body "AllTypeProcedure_Multiple -alnum    \"%1\" -alnum \"%1\"" \
211               -returnCodes error -result "*requires type 'alnum'*" -output "" -match glob
212      tests tepam-procargtype.ascii "tepam, Procedure argument type check - Ascii" \
213               -variations { abcdefghijklmnopqrstuvfxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 +*} \
214               -body "AllTypeProcedure_Multiple -ascii    \"%1\" -ascii \"%1\"" \
215               -result "" -output ""
216      tests tepam-procargtype.bool1 "tepam, Procedure argument type check - Boolean 1" \
217               -variations { 0 1 TRUE FALSE true false} \
218               -body "AllTypeProcedure_Multiple -boolean  \"%1\" -boolean \"%1\"" \
219               -result "" -output ""
220      tests tepam-procargtype.bool2 "tepam, Procedure argument type check - Boolean 2" \
221               -variations { "" " " 2 3 4 5 6 7 8 9 0xa 0xFF 1.123} \
222               -body "AllTypeProcedure_Multiple -boolean  \"%1\" -boolean \"%1\"" \
223               -returnCodes error -result "*requires type 'boolean'*" -output "" -match glob
224      tests tepam-procargtype.digit1 "tepam, Procedure argument type check - Digit 1" \
225               -variations { "" 0 1 2 3 4 5 6 7 8 9 0123456789} \
226               -body "AllTypeProcedure_Multiple -digit    \"%1\" -digit \"%1\"" \
227               -result "" -output ""
228      tests tepam-procargtype.digit2 "tepam, Procedure argument type check - Digit 2" \
229               -variations { " " a b c d e f g h i j k l m n A B C D E F G H I J K L + g %} \
230               -body "AllTypeProcedure_Multiple -digit    \"%1\" -digit \"%1\"" \
231               -returnCodes error -result "*requires type 'digit'*" -output "" -match glob
232      tests tepam-procargtype.double1 "tepam, Procedure argument type check - Double 1" \
233               -variations { 0 1 4 10 100 0x100 0xFFFF 00123 0.0 0.1 1.123 23.456 1E-1 1.23e3} \
234               -body "AllTypeProcedure_Multiple -double   \"%1\" -double \"%1\"" \
235               -result "" -output ""
236      tests tepam-procargtype.double2 "tepam, Procedure argument type check - Double 2" \
237               -variations { "" " " 0xFX1 a 12F ? .} \
238               -body "AllTypeProcedure_Multiple -double   \"%1\" -double \"%1\"" \
239               -returnCodes error -result "*requires type 'double'*" -output "" -match glob
240      tests tepam-procargtype.lower1 "tepam, Procedure argument type check - Lower 1" \
241               -variations { "" adsf lkva oiuwwe myxy} \
242               -body "AllTypeProcedure_Multiple -lower    \"%1\" -lower \"%1\"" \
243               -result "" -output ""
244      tests tepam-procargtype.lower2 "tepam, Procedure argument type check - Lower 2" \
245               -variations { " " asXdf asd.f "_:;" a_a} \
246               -body "AllTypeProcedure_Multiple -lower    \"%1\" -lower \"%1\"" \
247               -returnCodes error -result "*requires type 'lower'*" -output "" -match glob
248      tests tepam-procargtype.space1 "tepam, Procedure argument type check - Space 1" \
249               -variations {"" " " "   "} \
250               -body "AllTypeProcedure_Multiple -space \"%1\" -space \"%1\"" \
251               -result "" -output ""
252      tests tepam-procargtype.space2 "tepam, Procedure argument type check - Space 2" \
253               -variations { a lka 123 _ ? . , } \
254               -body "AllTypeProcedure_Multiple -space    \"%1\" -space \"%1\"" \
255               -returnCodes error -result "*requires type 'space'*" -output "" -match glob
256      tests tepam-procargtype.upper1 "tepam, Procedure argument type check - Upper 1" \
257               -variations { "" A B CDEF GHIJKLMNO PQRSTUVWXYZ} \
258               -body "AllTypeProcedure_Multiple -upper    \"%1\" -upper \"%1\"" \
259               -result "" -output ""
260      tests tepam-procargtype.upper2 "tepam, Procedure argument type check - Upper 2" \
261               -variations { " " a b cde CD.EF GHI1KLMNO PQRSTuVWXYZ ? . , ) (} \
262               -body "AllTypeProcedure_Multiple -upper    \"%1\" -upper \"%1\"" \
263               -returnCodes error -result "*requires type 'upper'*" -output "" -match glob
264      tests tepam-procargtype.xdigit1 "tepam, Procedure argument type check - Xdigit 1" \
265               -variations { 0123456789abcdefABCDEF} \
266               -body "AllTypeProcedure_Multiple -xdigit   \"%1\" -xdigit \"%1\"" \
267               -result "" -output ""
268      tests tepam-procargtype.xdigit2 "tepam, Procedure argument type check - Xdigit 2" \
269               -variations { g h i x y z _ ? .} \
270               -body "AllTypeProcedure_Multiple -xdigit   \"%1\" -xdigit \"%1\"" \
271               -returnCodes error -result "*requires type 'xdigit'*" -output "" -match glob
272
273######## Unknown types or untyped arguments ########
274
275   # Bad type declarations
276      test tepam-procargtype.badtd "tepam, Procedure argument type check - Bad type declaration" \
277               -body "tepam::procedure AllTypeProcedure {-args {{-unknown -type unknown -optional}} } {}" \
278               -returnCodes error -result "*type 'unknown' not known*" -output "" -match glob
279
280   # Unknown types
281      tests tepam-procargtype.unknown "tepam, Procedure argument type check - Unknown type" \
282               -body "tepam::procedure AllTypeProcedure {-args {{-unknown -optional}} } {}" \
283               -result "" -output ""
284
285######## That's all ########
286
287::tcltest::cleanupTests
288return
289
290##########################################################################
291# $RCSfile: proc_call_arg_type.test,v $ - ($Name:  $)
292# $Id: proc_call_arg_type.test,v 1.1 2010/02/11 21:50:55 droll Exp $
293# Modifications:
294# $Log: proc_call_arg_type.test,v $
295# Revision 1.1  2010/02/11 21:50:55  droll
296# TEPAM module checkin
297#
298##########################################################################
299
300