diff --git a/np.tcl b/np.tcl index da6a6e2..09c0da7 100644 --- a/np.tcl +++ b/np.tcl @@ -74,15 +74,16 @@ namespace eval ::np { break } - # if "var" doesn't start with a dash, flip to positional - if {[string index $arg 0] ne "-"} { - #puts "possible var '$arg' doesn't start with a dash, flip to positional" + # if "var" doesn't start with a dash or equal sign, flip to positional + set start_character [string index $arg 0] + if {$start_character ne "-" && $start_character ne "="} { + #puts "possible var '$arg' doesn't start with a dash or equal sign, flip to positional" break } # if "var" isn't known to us as a named parameter, flip to positional set var [string range $arg 1 end] - if {[lsearch $named $var] < 0} { + if {[lsearch $named $var] < 0 && $start_character ne "="} { #puts "'var' '$arg' not recognized, flip to positional" break } @@ -97,12 +98,22 @@ namespace eval ::np { # we're good, set the named parameter into the variable sets #puts [list set vsets($var) [lindex $realArgs 1]] + # but don't allow a valid named parameter to be set as a keyword parameter + if {$start_character eq "=" && [lsearch $named $var] >= 0} { + error [dict get $argd errmsg] "" [list TCL WRONGARGS] + } + # but don't allow the same variable to be set twice - if {[info exists vsets($var)]} { + if {[info exists vsets($var)] || [info exists kwsets($var)]} { error [dict get $argd errmsg] "" [list TCL WRONGARGS] } - set vsets($var) [lindex $realArgs 1] + # write to kwsets, if a keword argument was detected + if {$start_character eq "="} { + set kwsets($var) [lindex $realArgs 1] + } else { + set vsets($var) [lindex $realArgs 1] + } set realArgs [lrange $realArgs 2 end] } @@ -155,6 +166,16 @@ namespace eval ::np { upvar $var myvar set myvar $value } + + # create an empty dict in the caller's frame + upvar kwargs kw_args + set kw_args [dict create] + # now iterate through the var-value pairs and set the dict kwargs + # in the caller's frame + foreach "var value" [array get kwsets] { + #puts "set kw_args $var $value" + dict set kw_args $var $value + } return } @@ -184,4 +205,4 @@ namespace eval ::np { } } -package provide np 1.0.0 +package provide np 1.1.1 diff --git a/tests/np1.test b/tests/np1.test index d3e5d4d..0d528e0 100644 --- a/tests/np1.test +++ b/tests/np1.test @@ -340,4 +340,33 @@ test np-7.1 "call named parameters with expando" -setup { } -result "a defb c {}" + +test np-8.0 "regular and adhoc named parameter in a variable" -setup { + np::proc t {a --} { + return [list $a $kwargs] + } +} -body { + set n "-a" + set m "=b" + t $n a $m b +} -result "a {b b}" + +test np-8.1 "call regular and adhoc named parameters with expando" -setup { + np::proc t {a {b defb} -- c args} { + return [list $a $b $c $kwargs $args] + } +} -body { + set l {=d d -a a -- c} + t {*}$l +} -result "a defb c {d d} {}" + +test np-8.2 "call regular and double adhoc named parameters with expando" -setup { + np::proc t {a {b defb} -- c args} { + return [list $a $b $c $kwargs $args] + } +} -body { + set l {=d d -a a =e e -- c} + t {*}$l +} -result "a defb c {d d e e} {}" + cleanupTests