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