@ -612,6 +612,14 @@ tcl::namespace::eval punk::args {
# form_defs $F\
#]
}
proc errorstyle {args} {
#set or query the running config -errorstyle
#review - is this an override or a default? - what happens with punk::args::parse specifically set value of -errorstyle?
#values:
#debug, enhanced, standard, basic, minimal
error todo
}
proc define {args} {
dict get [resolve {*}$args] id
}
@ -2431,7 +2439,7 @@ tcl::namespace::eval punk::args {
tableobject "table object cmd"
table "full table laout"
}
-scheme -choices {nocolour info error}
-scheme -default error - choices {nocolour info error}
}] ]
#basic recursion blocker
@ -3113,8 +3121,6 @@ tcl::namespace::eval punk::args {
}
set arg_error_isrunning 0
#add PUNK to the tail end of the more usual -errorcode {TCL WRONGARGS} so we maintain reasonable compat with things looking for TCL WRONGARGS - but also differentiate it.
#Also, we're polite enough in the errorInfo, nothing wrong with a Clint Eastwood style errorCode ;)
if {$use_table} {
#assert returntype is one of table, tableobject
set result $errmsg ;#default if for some reason table couldn't be used
@ -3127,7 +3133,9 @@ tcl::namespace::eval punk::args {
set result $errmsg
}
if {$as_error} {
return -code error -errorcode {TCL WRONGARGS PUNK} $result
#add PUNK to the tail end of the more usual -errorcode {TCL WRONGARGS} so we maintain reasonable compat with things looking for TCL WRONGARGS - but also differentiate it.
#Also, we're polite enough in the errorInfo, nothing wrong with a Clint Eastwood style errorCode ;)
uplevel 1 [list return -code error -errorcode {TCL WRONGARGS PUNK} $result]
} else {
return $result
}
@ -3153,7 +3161,7 @@ tcl::namespace::eval punk::args {
mechanism and call punk::args::usage as necessary.
"
-return -default table -choices {string table tableobject}
} {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} {
} {${[punk::args::resolved_def -types opts -override {-scheme {-default info}} ::punk::args::arg_error -scheme]}} {
@values -min 0 -max 1
id -help\
@ -3232,7 +3240,7 @@ tcl::namespace::eval punk::args {
entries."
#default to enhanced errorstyle despite slow 'catch' (unhappy path) performance
#todo - configurable per interp/namespace
-errorstyle -type string -default enhanced -choices {enhanced standard minimal}
-errorstyle -type string -default enhanced -choices {enhanced standard basic minimal}
@values -min 2
@ -3282,11 +3290,20 @@ tcl::namespace::eval punk::args {
if {[llength $opts] % 2} {
error "punk::args::parse Even number of -flag val pairs required after arglist"
}
#Default the -errorstyle to enhanced
# (slowest on unhappy path - but probably clearest for playing with new APIs interactively)
# - application devs should distribute a config file with an errorstyle override if desired.
# - devs who prefer a different default for interactive use should create a config for it. (todo)
set defaultopts [dict create\
-form {*}\
-errorstyle enhanced\
]
set opts [dict merge $opts $defaultopts]
#todo - load override_errorstyle from configuration
#dict set defaultopts -errorstyle $
set opts [dict merge $defaultopts $opts]
dict for {k v} $opts {
switch -- $k {
-form - -errorstyle {
@ -3322,18 +3339,77 @@ tcl::namespace::eval punk::args {
}
try {
set result [punk::args::get_dict {*}$deflist $parseargs]
} trap {PUNKARGS} {msg opts} {
#trap punk::args argument validation/parsing errors and decide here
#whether to display basic error - or full usage if configured.
puts stderr "PUNKARGS: $msg\n$opts"
return
} trap {} {msg opts} {
} trap {PUNKARGS VALIDATION} {msg erroropts} {
set opt_errorstyle [dict get $opts -errorstyle]
#samples from get_dict (review: -argspecs <dict> can be *large* especially for multi-form argument definitions)
#return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choicecount [llength $c_list] minchoices $choicemultiple_min maxchoices $choicemultiple_max] -badarg $argname -argspecs $argspecs]] $msg
#return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg
set ecode [dict get $erroropts -errorcode]
#punk ecode is of form PUNKARGS VALIDATION {description..} -key val ...
set msg [string map [list %caller% [Get_caller]] $msg]
switch -- $opt_errorstyle {
minimal {
return -options [list -code error -errorcode $ecode] $msg
}
basic {
#No table layout - unix manpage style
set customdict [lrange $ecode 3 end]
set argspecs [Dict_getdef $customdict -argspecs ""]
set badarg [Dict_getdef $customdict -badarg ""]
if {$argspecs ne ""} {
set msg [arg_error $msg $argspecs -aserror 0 -return string -badarg $badarg]
}
return -options [list -code error -errorcode $ecode] $msg
}
standard {
set customdict [lrange $ecode 3 end]
set argspecs [Dict_getdef $customdict -argspecs ""]
set badarg [Dict_getdef $customdict -badarg ""]
if {$argspecs ne ""} {
set msg [arg_error $msg $argspecs -aserror 0 -badarg $badarg]
}
return -options [list -code error -errorcode $ecode] $msg
}
enhanced {
set estack [info errorstack] ;#save it before we do anything to replace it (like the catch below)
set customdict [lrange $ecode 3 end]
set argspecs [Dict_getdef $customdict -argspecs ""]
set badarg [Dict_getdef $customdict -badarg ""]
set ecode_summary [lrange $ecode 0 2]
if {$badarg ne ""} {
lappend ecode_summary -badarg $badarg
}
catch {package require punk::lib}
if {[package provide punk::lib] ne ""} {
append msg \n [punk::lib::showdict -roottype list $estack */*]
}
if {$argspecs ne ""} {
set msg [arg_error $msg $argspecs -aserror 0 -badarg $badarg]
append msg \n "::errorCode summary: $ecode_summary"
return -options [list -code error -errorcode $ecode] $msg
} else {
#why? todo?
append msg \n "(enhanced error information unavailable)"
append msg \n "::errorCode summary: $ecode_summary"
return -options [list -code error -errorcode $ecode] $msg
}
}
debug {
puts stderr "errorstyle debug not implemented"
return -options [list -code error -errorcode $ecode] $msg
}
}
} trap {PUNKARGS} {msg erropts} {
append msg \n "Unexpected PUNKARGS error"
return -options [list -code error -errorcode $ecode] $msg
} trap {} {msg erroropts} {
#review
#puts stderr "$msg\n$opts"
#quote from DKF: The reason for using return -code error vs error or throw depends on where the error is. If the problem is in your code, use error or throw.
#If the problem is in your caller (e.g., because they gave you bad arguments) then use return -code error. Simple.
throw [dict get $opts -errorcode] [dict get $opts -errorinfo]
return
throw [dict get $erroropts -errorcode] [dict get $erroropts -errorinfo]
}
return $result
}
@ -3453,6 +3529,7 @@ tcl::namespace::eval punk::args {
#puts "-arg_info->$arg_info"
set flagsreceived [list] ;#for checking if required flags satisfied
set solosreceived [list]
#secondary purpose:
#for -multple true, we need to ensure we can differentiate between a default value and a first of many that happens to match the default.
#-default value must not be appended to if argname not yet in flagsreceived
@ -3671,7 +3748,9 @@ tcl::namespace::eval punk::args {
#incr i to skip flagval
incr vals_remaining_possible -2
if {[incr i] > $maxidx} {
arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $fullopt
set msg "Bad options for %caller%. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list missingoptionvalue $fullopt index [expr {$i-1}]] -badarg $fullopt -argspecs $argspecs]] $msg
#arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $fullopt
}
} else {
#solo
@ -3686,6 +3765,7 @@ tcl::namespace::eval punk::args {
tcl::dict::set opts $fullopt 1
}
incr vals_remaining_possible -1
lappend solosreceived $fullopt ;#dups ok
}
lappend flagsreceived $fullopt ;#dups ok
} else {
@ -3714,7 +3794,9 @@ tcl::namespace::eval punk::args {
tcl::dict::set opts $a $newval
}
if {[incr i] > $maxidx} {
arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $a
set msg "Bad options for %caller%. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list missingoptionvalue $a index [expr {$i-1}]] -badarg $a -argspecs $argspecs]] $msg
#arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $a
}
incr vals_remaining_possible -2
} else {
@ -3729,15 +3811,17 @@ tcl::namespace::eval punk::args {
tcl::dict::set opts $a 1
}
incr vals_remaining_possible -1
lappend solosreceived $a
}
lappend flagsreceived $a ;#adhoc flag as supplied
} else {
if {[llength $OPT_NAMES]} {
set errmsg "bad options for [Get_caller] . Unexpected option \"$a\": must be one of: $OPT_NAMES"
set errmsg "bad options for %caller% . Unexpected option \"$a\": must be one of: $OPT_NAMES"
} else {
set errmsg "bad options for [Get_caller] . Unexpected option \"$a\": No options defined while @opts -any 0"
set errmsg "bad options for %caller% . Unexpected option \"$a\": No options defined while @opts -any 0"
}
arg_error $errmsg $argspecs -badarg $fullopt
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list invalidoption $a options $OPT_NAMES] -badarg $a -argspecs $argspecs]] $errmsg
#arg_error $errmsg $argspecs -badarg $fullopt
}
}
}
@ -3839,14 +3923,20 @@ tcl::namespace::eval punk::args {
if {$leadermax == -1} {
#only check min
if {$num_leaders < $leadermin} {
arg_error "bad number of leading values for [Get_caller]. Got $num_leaders leaders. Expected at least $leadermin" $argspecs
set msg "Bad number of leading values for %caller%. Got $num_leaders leaders. Expected at least $leadermin"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list leadingvaluecount $num_leaders min $leadermin max $leadermax] -argspecs $argspecs]] $msg
#arg_error "bad number of leading values for [Get_caller]. Got $num_leaders leaders. Expected at least $leadermin" $argspecs
}
} else {
if {$num_leaders < $leadermin || $num_leaders > $leadermax} {
if {$leadermin == $leadermax} {
arg_error "bad number of leading values for [Get_caller]. Got $num_leaders leaders. Expected exactly $leadermin" $argspecs
set msg "Bad number of leading values for %caller%. Got $num_leaders leaders. Expected exactly $leadermin"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list leadingvaluecount $num_leaders min $leadermin max $leadermax] -argspecs $argspecs]] $msg
#arg_error "bad number of leading values for [Get_caller]. Got $num_leaders leaders. Expected exactly $leadermin" $argspecs
} else {
arg_error "bad number of leading values for [Get_caller]. Got $num_leaders leaders. Expected between $leadermin and $leadermax inclusive" $argspecs
set msg "Bad number of leading values for %caller%. Got $num_leaders leaders. Expected between $leadermin and $leadermax inclusive"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list leadingvaluecount $num_leaders min $leadermin max $leadermax] -argspecs $argspecs]] $msg
#arg_error "bad number of leading values for [Get_caller]. Got $num_leaders leaders. Expected between $leadermin and $leadermax inclusive" $argspecs
}
}
}
@ -3854,14 +3944,20 @@ tcl::namespace::eval punk::args {
if {$val_max == -1} {
#only check min
if {$num_values < $val_min} {
arg_error "bad number of trailing values for [Get_caller]. Got $num_values values. Expected at least $val_min" $argspecs
set msg "Bad number of trailing values for %caller%. Got $num_values values. Expected at least $val_min"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list trailingvaluecount $num_values min $val_min max $val_max] -argspecs $argspecs]] $msg
#arg_error "bad number of trailing values for [Get_caller]. Got $num_values values. Expected at least $val_min" $argspecs
}
} else {
if {$num_values < $val_min || $num_values > $val_max} {
if {$val_min == $val_max} {
arg_error "bad number of trailing values for [Get_caller]. Got $num_values values. Expected exactly $val_min" $argspecs
set msg "Bad number of trailing values for %caller%. Got $num_values values. Expected exactly $val_min"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list trailingvaluecount $num_values min $val_min max $val_max] -argspecs $argspecs]] $msg
#arg_error "bad number of trailing values for [Get_caller]. Got $num_values values. Expected exactly $val_min" $argspecs
} else {
arg_error "bad number of trailing values for [Get_caller]. Got $num_values values. Expected between $val_min and $val_max inclusive" $argspecs
set msg "Bad number of trailing values for %caller%. Got $num_values values. Expected between $val_min and $val_max inclusive"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list trailingvaluecount $num_values min $val_min max $val_max] -argspecs $argspecs]] $msg
#arg_error "bad number of trailing values for [Get_caller]. Got $num_values values. Expected between $val_min and $val_max inclusive" $argspecs
}
}
}
@ -3888,13 +3984,19 @@ tcl::namespace::eval punk::args {
#}
#for now (2024-06) punk::lib::ldiff is a better compromise across normal/safe interps e.g 0.7/0.8us
if {[llength [set missing [punklib_ldiff $LEADER_REQUIRED $leadernames_received]]]} {
arg_error "Required leader missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs
set msg "Required leader missing for %caller%. missing values: '$missing' marked with -optional false - so must be present"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list leadermissing $missing received $leadernames_received] -argspecs $argspecs]] $msg
#arg_error "Required leader missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs
}
if {[llength [set missing [punklib_ldiff $opt_required $flagsreceived]]]} {
arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present " $argspecs
set msg "Required option missing for %caller%. missing flags: '$missing' are marked with -optional false - so must be present"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list optionmissing $missing received $flagsreceived] -argspecs $argspecs]] $msg
#arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present " $argspecs
}
if {[llength [set missing [punklib_ldiff $val_required $valnames_received]]]} {
arg_error "Required value missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs
set msg "Required value missing for %caller%. missing values: '$missing' marked with -optional false - so must be present"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list valuemissing $missing received $valnames_received] -argspecs $argspecs]] $msg
#arg_error "Required value missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs
}
@ -4007,11 +4109,11 @@ tcl::namespace::eval punk::args {
#-----------------------------------
#fast fail on the wrong number of choices
if {[llength $c_list] < $choicemultiple_min} {
set msg "Option $argname for [Get_caller] requires at least $choicemultiple_min choices. Received [llength $c_list] choices."
set msg "Option $argname for %caller% requires at least $choicemultiple_min choices. Received [llength $c_list] choices."
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choicecount [llength $c_list] minchoices $choicemultiple_min maxchoices $choicemultiple_max] -badarg $argname]] $msg
}
if {$choicemultiple_max != -1 && [llength $c_list] > $choicemultiple_max} {
set msg "Option $argname for [Get_caller] requires at most $choicemultiple_max choices. Received [llength $c_list] choices."
set msg "Option $argname for %caller% requires at most $choicemultiple_max choices. Received [llength $c_list] choices."
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choicecount [llength $c_list] minchoices $choicemultiple_min maxchoices $choicemultiple_max] -badarg $argname]] $msg
}
#-----------------------------------
@ -4142,7 +4244,10 @@ tcl::namespace::eval punk::args {
} else {
set prefixmsg ""
}
arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$c'" $argspecs -badarg $argname
#review: $c vs $c_check for -badval?
set msg "Option '$argname' for %caller% must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$c_check'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choiceviolation $c choices $allchoices] -badarg $argname -badval $c_check -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$c'" $argspecs -badarg $argname
}
}
incr choice_idx
@ -4178,7 +4283,9 @@ tcl::namespace::eval punk::args {
#do not run ta::detect on a list
foreach e $vlist {
if {[punk::ansi::ta::detect $e]} {
error "Option $argname for [Get_caller] contains ansi - but -allow_ansi is false. Received: '$e'"
set msg "Option '$argname' for %caller% contains ansi - but -allow_ansi is false. character-view: '[punk::ansi::ansistring VIEW $e]'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list contentviolation ansi] -badarg $argname -argspecs $argspecs]] $msg
#error "Option $argname for [Get_caller] contains ansi - but -allow_ansi is false. Received: '$e'"
}
}
}
@ -4200,7 +4307,9 @@ tcl::namespace::eval punk::args {
list {
foreach e_check $vlist_check {
if {![tcl::string::is list -strict $e_check]} {
arg_error "Option $argname for [Get_caller] requires type 'list'. Received: '$e_check'" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% requires type 'list'. Received: '$e_check'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires type 'list'. Received: '$e_check'" $argspecs -badarg $argname
}
if {[tcl::dict::size $thisarg_checks]} {
tcl::dict::for {checkopt checkval} $thisarg_checks {
@ -4208,13 +4317,17 @@ tcl::namespace::eval punk::args {
-minsize {
# -1 for disable is as good as zero
if {[llength $e_check] < $checkval} {
arg_error "Option $argname for [Get_caller] requires list with -minsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname
set msg "Option '$argname for %caller% requires list with -minsize $checkval. Received len:[llength $e_check]"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list sizeviolation $type minsize $checkval] -badarg $e -badval $e_check -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires list with -minsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname
}
}
-maxsize {
if {$checkval ne "-1"} {
if {[llength $e_check] > $checkval} {
arg_error "Option $argname for [Get_caller] requires list with -maxsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname
set msg "Option '$argname for %caller% requires list with -maxsize $checkval. Received len:[llength $e_check]"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list sizeviolation $type maxsize $checkval] -badarg $e -badval $e_check -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires list with -maxsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname
}
}
}
@ -4255,11 +4368,13 @@ tcl::namespace::eval punk::args {
#puts "----> checking $e vs regex $regexprefail"
if {[regexp $regexprefail $e]} {
if {[tcl::dict::exists $thisarg -regexprefailmsg]} {
#review - %caller% ??
set msg [tcl::dict::get $thisarg -regexprefailmsg]
} else {
set msg "Option $argname for [Get_caller] didn't pass regexprefail regex: '$regexprefail' got '$e'"
set msg "Option $argname for %caller% didn't pass regexprefail regex: '$regexprefail' got '$e'"
}
arg_error $msg $argspecs -badarg $argname
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $e -argspecs $argspecs]] $msg
#arg_error $msg $argspecs -badarg $argname
}
}
}
@ -4273,14 +4388,18 @@ tcl::namespace::eval punk::args {
package require punk::ansi
foreach e $remaining_e {
if {![punk::ansi::ta::detect $e]} {
arg_error "Option $argname for [Get_caller] requires ansistring - but no ansi detected" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% requires ansistring - but no ansi detected"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires ansistring - but no ansi detected" $argspecs -badarg $argname
}
}
}
globstring {
foreach e $remaining_e {
if {![regexp {[*?\[\]]} $e]} {
arg_error "Option $argname for [Get_caller] requires globstring - but no glob characters detected" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% requires globstring - but no glob characters detected"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires globstring - but no glob characters detected" $argspecs -badarg $argname
}
}
}
@ -4295,13 +4414,17 @@ tcl::namespace::eval punk::args {
-minsize {
# -1 for disable is as good as zero
if {[tcl::string::length $e_check] < $checkval} {
arg_error "Option $argname for [Get_caller] requires string with -minsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% requires string with -minsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list sizeviolation $type] -badarg $argname -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires string with -minsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname
}
}
-maxsize {
if {$checkval ne "-1"} {
if {[tcl::string::length $e_check] > $checkval} {
arg_error "Option $argname for [Get_caller] requires string with -maxsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% requires string with -maxsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list sizeviolation $type] -badarg $argname -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires string with -maxsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname
}
}
}
@ -4318,31 +4441,43 @@ tcl::namespace::eval punk::args {
if {$low eq ""} {
foreach e $vlist e_check $vlist_check {
if {![tcl::string::is integer -strict $e_check]} {
arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% requires type 'integer'. Received: '$e'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg
#arg_error "Option '$argname' for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname
}
#lowside unspecified - check only high
if {$e_check > $high} {
arg_error "Option $argname for [Get_caller] must be integer less than or equal to $high. Received: '$e'" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% must be integer greater than or equal to $hight. Received: '$e'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs]] $msg
#arg_error "Option '$argname' for [Get_caller] must be integer less than or equal to $high. Received: '$e'" $argspecs -badarg $argname
}
}
} elseif {$high eq ""} {
foreach e $vlist e_check $vlist_check {
if {![tcl::string::is integer -strict $e_check]} {
arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% requires type 'integer'. Received: '$e'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname
}
#highside unspecified - check only low
if {$e_check < $low} {
arg_error "Option $argname for [Get_caller] must be integer greater than or equal to $low. Received: '$e'" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% must be integer greater than or equal to $low. Received: '$e'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] must be integer greater than or equal to $low. Received: '$e'" $argspecs -badarg $argname
}
}
} else {
foreach e $vlist e_check $vlist_check {
if {![tcl::string::is integer -strict $e_check]} {
arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% requires type 'integer'. Received: '$e'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname
}
#high and low specified
if {$e_check < $low || $e_check > $high} {
arg_error "Option $argname for [Get_caller] must be integer between $low and $high inclusive. Received: '$e'" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% must be integer between $low and $high inclusive. Received: '$e'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] must be integer between $low and $high inclusive. Received: '$e'" $argspecs -badarg $argname
}
}
}
@ -4350,7 +4485,9 @@ tcl::namespace::eval punk::args {
} else {
foreach e_check $vlist_check {
if {![tcl::string::is integer -strict $e_check]} {
arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" $argspecs -badarg $argname
set msg "Option $argname for %caller% requires type integer. Received: '$e_check'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" $argspecs -badarg $argname
}
}
}
@ -4358,7 +4495,9 @@ tcl::namespace::eval punk::args {
double {
foreach e $vlist e_check $vlist_check {
if {![tcl::string::is double -strict $e_check]} {
error "Option $argname for [Get_caller] requires type 'double'. Received: '$e'"
set msg "Option $argname for %caller% requires type double. Received: '$e'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg
#error "Option $argname for [Get_caller] requires type 'double'. Received: '$e'"
}
if {[tcl::dict::size $thisarg_checks]} {
#safe jumptable test
@ -4370,7 +4509,9 @@ tcl::namespace::eval punk::args {
#todo - empty string for low or high
lassign $checkval low high
if {$e_check < $low || $e_check > $high} {
arg_error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" $argspecs -badarg $argname
set msg "Option $argname for %caller% must be double between $low and $high. Received: '$e'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" $argspecs -badarg $argname
}
}
}
@ -4381,14 +4522,18 @@ tcl::namespace::eval punk::args {
bool {
foreach e_check $vlist_check {
if {![tcl::string::is boolean -strict $e_check]} {
arg_error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" $argspecs -badarg $argname
set msg "Option $argname for %caller% requires type boolean. Received: '$e_check'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" $argspecs -badarg $argname
}
}
}
dict {
foreach e_check $vlist_check {
if {[llength $e_check] %2 != 0} {
arg_error "Option $argname for [Get_caller] requires type 'dict' - must be key value pairs. Received: '$e_check'" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% requires type 'dict' - must be key value pairs. Received: '$e_check'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -badval $e_check -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires type 'dict' - must be key value pairs. Received: '$e_check'" $argspecs -badarg $argname
}
if {[tcl::dict::size $thisarg_checks]} {
tcl::dict::for {checkopt checkval} $thisarg_checks {
@ -4396,13 +4541,17 @@ tcl::namespace::eval punk::args {
-minsize {
# -1 for disable is as good as zero
if {[tcl::dict::size $e_check] < $checkval} {
arg_error "Option $argname for [Get_caller] requires dict with -minsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% requires dict with -minsize $checkval. Received dict size:[dict size $e_check]"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list sizeviolation $type minsize $checkval] -badarg $argname -badval $e_check -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires dict with -minsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname
}
}
-maxsize {
if {$checkval ne "-1"} {
if {[tcl::dict::size $e_check] > $checkval} {
arg_error "Option $argname for [Get_caller] requires dict with -maxsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname
set msg "Option '$argname' for %caller% requires dict with -maxsize $checkval. Received dict size:[dict size $e_check]"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list sizeviolation $type maxsize $checkval] -badarg $argname -badval $e_check -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires dict with -maxsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname
}
}
}
@ -4426,12 +4575,13 @@ tcl::namespace::eval punk::args {
xdigit {
foreach e $vlist e_check $vlist_check {
if {![tcl::string::is $type $e_check]} {
set msg "Option $argname for [Get_caller] requires type '$type'. Received: '$e'"
# set msg "Option $argname for [Get_caller] requires type '$type'. Received: '$e'"
#try trap?
#return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type]]] $result
#throw ?
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname]] $msg
arg_error $msg $argspecs -badarg $argname
set msg "Option $argname for %caller% requires type '$type'. Received: '$e'"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg
#arg_error $msg $argspecs -badarg $argname
}
}
}
@ -4443,27 +4593,36 @@ tcl::namespace::eval punk::args {
#//review - we may need '?' char on windows
if {!([tcl::string::length $e_check]>0 && ![regexp {[\"*<>\;]} $e_check])} {
#what about special file names e.g on windows NUL ?
arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" $argspecs -badarg $argname
set msg "Option $argname for %caller% requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" $argspecs -badarg $argname
}
}
if {$type eq "existingfile"} {
foreach e $vlist e_check $vlist_check {
if {![file exists $e_check]} {
arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" $argspecs -badarg $argname
set msg "Option $argname for %caller% requires type '$type'. Received: '$e' which is not an existing file"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -badval $e -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" $argspecs -badarg $argname
}
}
} elseif {$type eq "existingdirectory"} {
foreach e $vlist e_check $vlist_check {
if {![file isdirectory $e_check]} {
arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" $argspecs -badarg $argname
set msg "Option $argname for %caller% requires type '$type'. Received: '$e' which is not an existing directory"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -badval $e -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" $argspecs -badarg $argname
}
}
}
}
char {
#review - char vs unicode codepoint vs grapheme?
foreach e $vlist e_check $vlist_check {
if {[tcl::string::length $e_check] != 1} {
arg_error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" $argspecs -badarg $argname
set msg "Option $argname for %caller% requires type 'character'. Received: '$e' which is not a single character"
return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -badval $e -argspecs $argspecs]] $msg
#arg_error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" $argspecs -badarg $argname
}
}
}
@ -4515,7 +4674,7 @@ tcl::namespace::eval punk::args {
#(e.g using 'dict exists $received -flag')
# - but it can have duplicate keys when args/opts have -multiple 1
#It is actually a list of paired elements
return [tcl::dict::create leaders $leaders_dict opts $opts values $values_dict received $received_posns]
return [tcl::dict::create leaders $leaders_dict opts $opts values $values_dict received $received_posns solos $solosreceived ]
}
#proc sample1 {p1 args} {
