diff --git a/CHANGELOG.md b/CHANGELOG.md index d4b846df..95a5b891 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,10 @@ The latest `## [X.Y.Z]` header must match the `version` field in `punkproject.to Entries are newest-first; one bullet per notable change. See the root `AGENTS.md` "Project Versioning" section for the bump policy. +## [0.12.29] - 2026-07-14 + +- punk::args 0.12.2 comment/documentation hygiene pass (no behaviour change): ~1100 lines of superseded commented-out code removed (old check_clausecolumn, abandoned _check_clausecolumn2 experiment with its error-collection idea preserved as a note for G-072-era rework, pre-parsekey ordering loop, disabled switch arm, debug remnants); MAINTENANCE loop-parity comments upgraded to a dated refactor assessment (shared-helper extraction deferred to ride G-084 under G-046 hot-path constraints); user-visible doc fixes (get_dict return-shape and directive lists corrected, false solo-flag/last-value-only claims removed, two broken doc examples fixed); goal cross-refs (G-053, G-084) annotated at the relevant code sites; a suspected latent bug in the multi-member clause stringstartswith( arm flagged in a comment (matches the type string instead of the value) without changing behaviour. + ## [0.12.28] - 2026-07-14 - G-082 (achieved): punk::args 0.12.1 single-form parse error selection - a word rejected by an optional argument's allocation screen (restricted choices, or the basic int/double/bool/number/dict type screen) that then overflows the argument list now reports the specific rejection (choiceviolation naming the word and allowed choices, or typemismatch naming the type, with -badarg/-badval) instead of the generic "Received more values than can be assigned" overflow - restoring the 0.5.0-era pointedness for optional choice-restricted dispatch shapes (shell-visible in usage errors from punk::args-parsed commands). Genuinely-surplus words still report toomanyarguments; multiform selection unchanged. New errorselection.test (pre-fix behaviour characterized first, pins flipped deliberately); the make.tcl `-optional 0` authoring workaround is no longer needed on fixed versions (src/modules/AGENTS.md guideline re-documented; make.tcl keeps it while running against the bootsupport 0.12.0 snapshot). diff --git a/punkproject.toml b/punkproject.toml index 29cbae48..62479bb4 100644 --- a/punkproject.toml +++ b/punkproject.toml @@ -1,4 +1,4 @@ [project] name = "punkshell" -version = "0.12.28" +version = "0.12.29" license = "BSD-2-Clause" diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index 6150f815..7d68adf6 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/src/modules/punk/args-999999.0a1.0.tm @@ -68,7 +68,7 @@ #}] #[para]The lines beginning with @ are usually optional in most cases and can be used to set defaults and some extra controls #[para] - the above example would work just fine with only the - lines, but would allow zero filenames to be supplied as no -min value is set for @values -#[para]valid @ lines being with @cmd @leaders @opts @values +#[para]valid @ directive lines begin with @id @cmd @form @leaders @opts @values @formdisplay @doc @examples (plus the bare directives @dynamic and @normalize) #[para]lines beginning with a dash define options - a name can optionally be given to each trailing positional argument. #[para]If no names are defined for positional arguments, they will end up in the values key of the dict with numerical keys starting at zero. #[para]e.g the result from the punk::args::parse call above may be something like: @@ -84,15 +84,15 @@ # -translation -default binary # -nocomplain -type none # @values -min 2 -max 2 -# fileA -type existingfile 1 -# fileB -type existingfile 1 +# fileA -type existingfile +# fileB -type existingfile # }]] leaders opts values # puts "$category fileA: [dict get $values fileA]" # puts "$category fileB: [dict get $values fileB]" # } #}] #[para]By using standard tcl proc named arguments prior to args, and setting @values -min 0 -max 0 -#[para]a Tk-style ordering can be acheived, where punk::args is only handling the trailing flags and the values element of the returned dict can be ignored +#[para]a Tk-style ordering can be achieved, where punk::args is only handling the trailing flags and the values element of the returned dict can be ignored #[para]This use of leading positional arguments means the type validation features can't be applied to them. It can be done manually as usual, #[para] or an additional call could be made to punk::args e.g #[example { @@ -2246,13 +2246,6 @@ tcl::namespace::eval punk::args { set instance_info {} set keywords_info {} set examples_info {} - ###set leader_min 0 - ###set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit - #set leader_max "" - #(common case of no leaders specified) - #set opt_any 0 - #set val_min 0 - #set val_max -1 ;#-1 for no limit set DEF_definition_id $id #form_defs @@ -6366,7 +6359,7 @@ tcl::namespace::eval punk::args { In the 'withid' form the definition is a pre-existing record that has been created with ::punk::args::define, or indirectly by adding a definition to the PUNKARGS variable in a namespace which is then registered in - punk::args::register::NAMESPACES, or by a previous call to punk::parse + punk::args::register::NAMESPACES, or by a previous call to punk::args::parse using 'withdef' and a definition block containing an @id -id directive. In the 'withdef' form - the definition is created on the first call and @@ -6391,8 +6384,9 @@ tcl::namespace::eval punk::args { } proc myfunc {args} { set argd [punk::args::parse $args withid ::myns::myfunc] - lassign [dict values $argd] leaders opts values received solos - if {[dict exists $received] -configfile} { + set opts [dict get $argd opts] + set received [dict get $argd received] + if {[dict exists $received -configfile]} { puts "have option for existing file [dict get $opts -configfile]" } } @@ -6402,13 +6396,13 @@ tcl::namespace::eval punk::args { The received key is dict-like but can have repeated keys for arguments than can accept multiples. The value for each received element is the ordinal position of each clause. - ie in the common case where each argument is a single value, the ordinal positiion - will correspond too the position of the argument in the arglist. But if an argument can be + ie in the common case where each argument is a single value, the ordinal position + will correspond to the position of the argument in the arglist. But if an argument can be a clause of multiple values (possibly with some values in the clause being optional), then there will not be a direct correlation between the position of the argument in the arglist and the ordinal position of the clause received for that argument. An example of a multivalued clause is an argument defined with a -type that has multiple elements, - e.g coord -type {int int}. This is a dictinct situation to an argument defined with -multiple true + e.g coord -type {int int}. This is a distinct situation to an argument defined with -multiple true where the argument can be repeated but each clause is a single value. In the coord example, if it is also designated with -multiple true, the first clause received for the coord argument would have an ordinal position of 0, and the second clause received for the coord argument would @@ -7836,6 +7830,15 @@ tcl::namespace::eval punk::args { } set tp [string trim $tp ?] #puts "private::get_dict_can_assign_value: checking tp '$tp' against value '$rv'" + #------------------------------------------------------------------- + #2026-07-14 Agent-Updated + #A disabled XXXliteral* arm (superseded by the literal(* arm) was + #removed from the switch below. Still open from it: literalprefix(...) + #members are not handled in this multi-member tail-clause walk (only + #exact literal(...) - the single-member path above does handle + #literalprefix). Note: comments must never be placed between the + #switch arms themselves. + #------------------------------------------------------------------- switch -glob -- $tp { "literal(*" { set litmatch [string range $tp 8 end-1] @@ -7851,25 +7854,14 @@ tcl::namespace::eval punk::args { } } } - XXXliteral* { - #JJJ - set litinfo [string range $tp 7 end] - set match [string range $litinfo 1 end-1] - #todo -literalprefix - if {$rv eq $match} { - set alloc_ok 1 ;#we need at least one literal-match to set alloc_ok - incr alloc_count - } else { - if {$clause_member_optional} { - # - } else { - set alloc_ok 0 - break - } - } - } "stringstartswith(*" { set pfx [string range $tp 17 end-1] + #2026-07-14 Agent-Generated: suspected bug - this matches + #against $tp (the type string) rather than $rv (the value), + #so the branch always takes the success path ("$pfx*" is a + #prefix-match of the type it was cut from). Behaviour + #deliberately left unchanged in this comment-review pass - + #no pins exist; flag for a correctness pass. if {[string match "$pfx*" $tp]} { set alloc_ok 1 incr alloc_count @@ -7930,7 +7922,9 @@ tcl::namespace::eval punk::args { set num_remaining [llength $all_remaining] if {[dict get $ARG_INFO $thisname -optional] || ([dict get $ARG_INFO $thisname -multiple] && $thisname in $namesreceived)} { - #todo - check -multiple for required min/max (not implemented: make -multiple accept ?) + #2026-07-14 Agent-Updated: occurrence min/max for -multiple is goal G-053 + #(proposed: -multiple accepts a {min max} range alongside the legacy booleans). + #Not implemented - only boolean -multiple semantics apply here. #thisname already satisfied, or not required set tail_needs 0 foreach t $tailnames { @@ -8306,406 +8300,19 @@ tcl::namespace::eval punk::args { } } - #old version - ###proc private::check_clausecolumn {argname argclass thisarg thisarg_checks clausecolumn type_expression clausevalues_raw clausevalues_check argspecs} { - ### #set type $type_expression ;#todo - 'split' on | - ### set vlist $clausevalues_raw - ### set vlist_check $clausevalues_check - - ### set type_alternatives [private::split_type_expression $type_expression] - ### #each type_alternative is a list of varying length depending on arguments supported by first word. - ### #TODO? - ### #single element types: int double string etc - ### #two element types literal literalprefix stringstartswith stringendswith - ### #TODO - ### set stype [lindex $type_alternatives 0] - ### #e.g int - ### #e.g {literal blah)etc} - ### set type [lindex $stype 0] - ### #switch on first word of each stype - ### # - - ### #review - for leaders,values - do we need to check literal etc? already checked during split into prevalues postvalues ? - ### switch -- $type { - ### any {} - ### literal { - ### foreach clauseval $vlist { - ### set e [lindex $clauseval $clausecolumn] - ### set testval [lindex $stype 1] - ### if {$e ne $testval} { - ### set msg "$argclass '$argname' for %caller% requires literal value '$testval'. Received: '$e'" - ### return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg - ### } - ### } - ### } - ### stringstartwith { - ### foreach clauseval $vlist { - ### set e [lindex $clauseval $clausecolumn] - ### set testval [lindex $stype 1] - ### if {![string match $testval* $e]} { - ### set msg "$argclass '$argname' for %caller% requires stringstartswith value '$argname'. Received: '$e'" - ### return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg - ### } - ### } - ### } - ### list { - ### foreach clauseval_check $vlist_check { - ### set e_check [lindex $clauseval_check $clausecolumn] - ### if {![tcl::string::is list -strict $e_check]} { - ### set msg "$argclass '$argname' for %caller% requires type 'list'. Received: '$e_check'" - ### return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e_check -argspecs $argspecs]] $msg - ### } - ### if {[tcl::dict::size $thisarg_checks]} { - ### tcl::dict::for {checkopt checkval} $thisarg_checks { - ### switch -- $checkopt { - ### -minsize { - ### # -1 for disable is as good as zero - ### if {[llength $e_check] < $checkval} { - ### set msg "$argclass '$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_check -badval $e_check -argspecs $argspecs]] $msg - ### } - ### } - ### -maxsize { - ### if {$checkval ne "-1"} { - ### if {[llength $e_check] > $checkval} { - ### set msg "$argclass '$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_check -badval $e_check -argspecs $argspecs]] $msg - ### } - ### } - ### } - ### } - ### } - ### } - ### } - ### } - ### indexexpression { - ### foreach clauseval_check $vlist_check { - ### set e_check [lindex $clauseval_check $clausecolumn] - ### if {[catch {lindex {} $e_check}]} { - ### set msg "$argclass $argname for %caller% requires type indexexpression. An index as used in Tcl list commands. Received: '$e_check'" - ### return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg - ### } - ### } - ### } - ### string - ansistring - globstring { - ### #we may commonly want exceptions that ignore validation rules - most commonly probably the empty string - ### #we possibly don't want to always have to regex on things that don't pass the other more basic checks - ### # -regexprefail -regexprepass (short-circuiting fail/pass run before all other validations) - ### # -regexpostfail -regexpostpass (short-circuiting fail/pass run after other toplevel validations - but before the -validationtransform) - ### # in the comon case there should be no need for a tentative -regexprecheck - just use a -regexpostpass instead - ### # however - we may want to run -regexprecheck to restrict the values passed to the -validationtransform function - ### # -regexpostcheck is equivalent to -regexpostpass at the toplevel if there is no -validationtransform (or if it is in the -validationtransform) - ### # If there is a -validationtransform, then -regexpostcheck will either progress to run the -validationtransform if matched, else produce a fail - - ### #todo? - way to validate both unstripped and stripped? - ### set pass_quick_list_e [list] - ### set pass_quick_list_e_check [list] - ### set remaining_e $vlist - ### set remaining_e_check $vlist_check - ### #review - order of -regexprepass and -regexprefail in original rawargs significant? - ### #for now -regexprepass always takes precedence - ### set regexprepass [tcl::dict::get $thisarg -regexprepass] - ### set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 - ### if {$regexprepass ne ""} { - ### foreach clauseval $vlist clauseval_check $vlist_check { - ### set e [lindex $clauseval $clausecolumn] - ### set e_check [lindex $clauseval_check $clausecolumn] - ### if {[regexp [lindex $regexprepass $clausecolumn] $e]} { - ### lappend pass_quick_list_e $clauseval - ### lappend pass_quick_list_e_check $clauseval_check - ### } - ### } - ### set remaining_e [punklib_ldiff $vlist $pass_quick_list_e] - ### set remaining_e_check [punklib_ldiff $vlist_check $pass_quick_list_e_check] - ### } - ### if {$regexprefail ne ""} { - ### foreach clauseval $remaining_e clauseval_check $remaining_e_check { - ### set e [lindex $clauseval $clausecolumn] - ### set e_check [lindex $clauseval_check $clausecolumn] - ### #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 "$argclass $argname for %caller% didn't pass regexprefail regex: '$regexprefail' got '$e'" - ### } - ### return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $argname -argspecs $argspecs]] $msg - ### } - ### } - ### } - ### switch -- $type { - ### ansistring { - ### #we need to respect -validate_ansistripped for -minsize etc, but the string must contain ansi - ### #.. so we need to look at the original values in $vlist not $vlist_check - - ### #REVIEW - difference between string with mixed plaintext and ansi and one required to be ansicodes only?? - ### #The ansicodes only case should be covered by -minsize 0 -maxsize 0 combined with -validate_ansistripped ??? - ### package require punk::ansi - ### foreach clauseval $remaining_e { - ### set e [lindex $clauseval $clausecolumn] - ### if {![punk::ansi::ta::detect $e]} { - ### set msg "$argclass '$argname' for %caller% requires ansistring - but no ansi detected" - ### return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg - ### } - ### } - ### } - ### globstring { - ### foreach clauseval $remaining_e { - ### set e [lindex $clauseval $clausecolumn] - ### if {![regexp {[*?\[\]]} $e]} { - ### set msg "$argclass '$argname' for %caller% requires globstring - but no glob characters detected" - ### return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg - ### } - ### } - ### } - ### } - - ### if {[tcl::dict::size $thisarg_checks]} { - ### foreach clauseval $remaining_e_check { - ### set e_check [lindex $clauseval $clausecolumn] - ### if {[dict exists $thisarg_checks -minsize]} { - ### set minsize [dict get $thisarg_checks -minsize] - ### # -1 for disable is as good as zero - ### if {[tcl::string::length $e_check] < $minsize} { - ### set msg "$argclass '$argname' for %caller% requires string with -minsize $minsize. 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 - ### } - ### } - ### if {[dict exists $thisarg_checks -maxsize]} { - ### set maxsize [dict get $thisarg_checks -maxsize] - ### if {$checkval ne "-1"} { - ### if {[tcl::string::length $e_check] > $maxsize} { - ### set msg "$argclass '$argname' for %caller% requires string with -maxsize $maxsize. 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 - ### } - ### } - ### } - ### } - ### } - ### } - ### number { - ### #review - consider effects of Nan and Inf - ### #NaN can be considered as 'technically' a number (or at least a special numeric value) - ### foreach clauseval_check $vlist_check { - ### set e_check [lindex $clauseval_check $clausecolumn] - ### if {(![tcl::string::is integer -strict $e_check]) && (![tcl::string::is double -strict $e_check])} { - ### set msg "$argclass $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 - ### } - ### } - ### if {[tcl::dict::exists $thisarg -typeranges]} { - ### set ranges [tcl::dict::get $thisarg -typeranges] - ### foreach clauseval $vlist clauseval_check $vlist_check { - ### set e [lindex $clauseval $clausecolumn] - ### set e_check [lindex $clauseval_check $clausecolumn] - ### set range [lindex $ranges $clausecolumn] - ### lassign {} low high ;#set both empty - ### lassign $range low high - - ### if {"$low$high" ne ""} { - ### if {[::tcl::mathfunc::isnan $e]} { - ### set msg "$argclass '$argname' for %caller% must be an int or double within specified range {'$low' '$high'} NaN not comparable to any range. Received: '$e'" - ### return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs]] $msg - ### } - ### if {$low eq ""} { - ### if {$e_check > $high} { - ### set msg "$argclass '$argname' for %caller% must be an int or double less than or equal to $high. Received: '$e'" - ### return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs]] $msg - ### } - ### } elseif {$high eq ""} { - ### if {$e_check < $low} { - ### set msg "$argclass '$argname' for %caller% must be an int or double 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 - ### } - ### } else { - ### if {$e_check < $low || $e_check > $high} { - ### set msg "$argclass '$argname' for %caller% must be an int or double between $low and $high inclusive. Received: '$e'" - ### return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs]] $msg - ### } - ### } - ### } - ### } - ### } - ### } - ### int { - ### #elements in -typeranges can be expressed as two integers or an integer and an empty string e.g {0 ""} >= 0 or {"" 10} <=10 or {-1 10} -1 to 10 inclusive - ### foreach clauseval_check $vlist_check { - ### set e_check [lindex $clauseval_check $clausecolumn] - ### if {![tcl::string::is integer -strict $e_check]} { - ### set msg "$argclass $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 - ### } - ### } - ### if {[tcl::dict::exists $thisarg -typeranges]} { - ### set ranges [tcl::dict::get $thisarg -typeranges] - ### foreach clauseval $vlist clauseval_check $vlist_check { - ### set e [lindex $clauseval $clausecolumn] - ### set e_check [lindex $clauseval_check $clausecolumn] - ### set range [lindex $ranges $clausecolumn] - ### lassign $range low high - ### if {"$low$high" ne ""} { - ### if {$low eq ""} { - ### #lowside unspecified - check only high - ### if {$e_check > $high} { - ### set msg "$argclass '$argname' for %caller% must be integer less than or equal to $high. Received: '$e'" - ### return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs]] $msg - ### } - ### } elseif {$high eq ""} { - ### #highside unspecified - check only low - ### if {$e_check < $low} { - ### set msg "$argclass '$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 - ### } - ### } else { - ### #high and low specified - ### if {$e_check < $low || $e_check > $high} { - ### set msg "$argclass '$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 - ### } - ### } - ### } - ### } - ### } - ### } - ### double { - ### foreach clauseval $vlist clauseval_check $vlist_check { - ### set e_check [lindex $clauseval_check $clausecolumn] - ### if {![tcl::string::is double -strict $e_check]} { - ### set e [lindex $clauseval $clausecolumn] - ### set msg "$argclass $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 - ### } - ### } - ### if {[tcl::dict::size $thisarg_checks]} { - ### if {[dict exists $thisarg_checks -typeranges]} { - ### set ranges [dict get $thisarg_checks -typeranges] - ### foreach clauseval $vlist clauseval_check $vlist_check { - ### set e_check [lindex $clauseval_check $clausecolumn] - ### set range [lindex $ranges $clausecolumn] - ### #todo - small-value double comparisons with error-margin? review - ### #todo - empty string for low or high - ### lassign $range low high - ### if {$e_check < $low || $e_check > $high} { - ### set e [lindex $clauseval $clausecolumn] - ### set msg "$argclass $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 - ### } - ### } - ### } - ### } - ### } - ### bool { - ### foreach clauseval_check $vlist_check { - ### set e_check [lindex $clauseval_check $clausecolumn] - ### if {![tcl::string::is boolean -strict $e_check]} { - ### set msg "$argclass $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 - ### } - ### } - ### } - ### dict { - ### foreach clauseval_check $vlist_check { - ### set e_check [lindex $clauseval_check $clausecolumn] - ### if {[llength $e_check] %2 != 0} { - ### set msg "$argclass '$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 - ### } - ### } - ### if {[tcl::dict::size $thisarg_checks]} { - ### if {[dict exists $thisarg_checks -minsize]} { - ### set minsizes [dict get $thisarg_checks -minsize] - ### foreach clauseval_check $vlist_check { - ### set e_check [lindex $clauseval_check $clausecolumn] - ### set minsize [lindex $minsizes $clausecolumn] - ### # -1 for disable is as good as zero - ### if {[tcl::dict::size $e_check] < $minsize} { - ### set msg "$argclass '$argname' for %caller% requires dict with -minsize $minsize. Received dict size:[dict size $e_check]" - ### return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list sizeviolation $type minsize $minsize] -badarg $argname -badval $e_check -argspecs $argspecs]] $msg - ### } - ### } - ### } - ### if {[dict exists $thisarg_checks -maxsize]} { - ### set maxsizes [dict get $thisarg_checks -maxsize] - ### foreach clauseval_check $vlist_check { - ### set e_check [lindex $clauseval_check $clausecolumn] - ### set maxsize [lindex $maxsizes $clausecolumn] - ### if {$maxsize ne "-1"} { - ### if {[tcl::dict::size $e_check] > $maxsize} { - ### set msg "$argclass '$argname' for %caller% requires dict with -maxsize $maxsize. Received dict size:[dict size $e_check]" - ### return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list sizeviolation $type maxsize $maxsize] -badarg $argname -badval $e_check -argspecs $argspecs]] $msg - ### } - ### } - ### } - ### } - ### } - ### } - ### alnum - - ### alpha - - ### ascii - - ### control - - ### digit - - ### graph - - ### lower - - ### print - - ### punct - - ### space - - ### upper - - ### wordchar - - ### xdigit { - ### foreach clauseval $vlist clauseval_check $vlist_check { - ### set e_check [lindex $clauseval_check $clausecolumn] - ### if {![tcl::string::is $type -strict $e_check]} { - ### set e [lindex $clauseval $t] - ### set msg "$argclass $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 - ### } - ### } - ### } - ### file - - ### directory - - ### existingfile - - ### existingdirectory { - ### foreach clauseval $vlist clauseval_check $vlist_check { - ### set e [lindex $clauseval $clausecolumn] - ### set e_check [lindex $clauseval_check $clausecolumn] - ### #//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 ? - ### set msg "$argclass $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 - ### } - ### if {$type eq "existingfile"} { - ### if {![file exists $e_check]} { - ### set msg "$argclass $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 - ### } - ### } elseif {$type eq "existingdirectory"} { - ### if {![file isdirectory $e_check]} { - ### set msg "$argclass $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 - ### } - ### } - ### } - ### } - ### char { - ### #review - char vs unicode codepoint vs grapheme? - ### foreach clauseval $vlist clauseval_check $vlist_check { - ### set e_check [lindex $clauseval_check $clausecolumn] - ### if {[tcl::string::length $e_check] != 1} { - ### set e [lindex $clauseval $clausecolumn] - ### set msg "$argclass $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 - ### } - ### } - ### } - ### default { - ### } - ### } - - ###} - - #new version + + #------------------------------------------------------------------------------- + #2026-07-14 Agent-Updated + #Two superseded commented-out implementations were removed here (see git history + #prior to punkshell 0.12.28 if needed): + # - the pre-typelist-signature 'old version' of private::check_clausecolumn + # - '_check_clausecolumn2', an abandoned 'interim version' experiment whose one + # idea worth keeping was: collect per-clause validation results in a + # clause_results structure and report at the end, instead of raising on the + # first failing clause. If clause validation is reworked (e.g G-072 compound + # clause types / per-alternate handlers), that error-collection approach is a + # candidate shape. + #------------------------------------------------------------------------------- #list_of_clauses_raw list of (possibly)multi-value clauses for a particular argname #common basic case: list of single item being a single value clause. #precondition: list_of_clauses_raw has 'list protected' clauses of length 1 e.g if value is a dict {a A} @@ -9394,717 +9001,6 @@ tcl::namespace::eval punk::args { } - ##interim version - ##list_of_clauses_raw list of (possibly)multi-value clauses for a particular argname - ##common basic case: list of single item being a single value clause. - ##precondition: list_of_clauses_raw has 'list protected' clauses of length 1 e.g if value is a dict {a A} - #proc _check_clausecolumn2 {argname argclass thisarg thisarg_checks clausecolumn type_expression list_of_clauses_raw list_of_clauses_check argspecs} { - # if {$argname eq "frametype"} { - # puts "--->checking arg:$argname clausecolumn:$clausecolumn checkvalues:[lsearch -all -inline -index $clausecolumn -subindices $list_of_clauses_check *] against type_expression $type_expression" - # puts "--->list_of_clauses_raw : $list_of_clauses_raw" - # puts "--->list_of_clauses_check: $list_of_clauses_check" - # puts "--->$argname -type: [dict get $thisarg -type]" - # } - - # set clause_size [llength [dict get $thisarg -type]] ;#length of full type - not just passed type_expression - - # #set vlist [list] - # set clauses_dict [dict create] ;#key is ordinal position, remove entries as they are satsified - # set cidx -1 - # foreach cv $list_of_clauses_raw { - # incr cidx - # #REVIEW - # #if {$clause_size ==1} { - # # lappend vlist [list $cidx [list $cv]] - # #} else { - # #lappend vlist [list $cidx $cv] ;#store the index so we can reduce vlist as we go - # dict set clauses_dict $cidx $cv - # #} - # } - # #set vlist_check [list] - # set clauses_dict_check [dict create] - # set cidx -1 - # foreach cv $list_of_clauses_check { - # incr cidx - # #if {$clause_size == 1} { - # # lappend vlist_check [list $cidx [list $cv]] - # #} else { - # #lappend vlist_check [list $cidx $cv] - # dict set clauses_dict_check $cidx $cv - # #} - # } - - # set type_alternatives [private::split_type_expression $type_expression] - # #each type_alternative is a list of varying length depending on arguments supported by first word. - # #TODO? - # #single element types: int double string etc - # #two element types literal literalprefix stringstartswith stringendswith - # #TODO - - # #list for each clause (each clause is itself a list - usually length 1 but can be any length - we are dealing only with one column of the clauses) - # set clause_results [lrepeat [llength $list_of_clauses_raw] [lrepeat [llength $type_alternatives] _]] - # #e.g for list_of_clauses_raw {{a b c} {1 2 3}} when clausecolumn is 0 - # #-types {int|char|literal(ok) char double} - # #we are checking a and 1 against the type_expression int|char|literal(ok) (type_alternatives = {int char literal(ok)} - # #our initial clause_results in this case is a 2x2 list {{_ _ _} {_ _ _}} - # # - - - # set a_idx -1 - # foreach typealt $type_alternatives { - # incr a_idx - - # set type [lindex $typealt 0] - # #e.g int - # #e.g {literal blah} - # #e.g {literalprefix abc} - - # #switch on first word of each typealt - # # - - # #review - for leaders,values - do we need to check literal etc? already checked during split into prevalues postvalues ? - # switch -- $type { - # any {} - # literal { - # dict for {c_idx clauseval} $clauses_dict { - # set e [lindex $clauseval $clausecolumn] - # set testval [lindex $typealt 1] - # if {$e ne $testval} { - # set msg "$argclass '$argname' for %caller% requires literal value '$testval'. Received: '$e'" - # #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs] msg $msg] - # } else { - # lset clause_results $c_idx $a_idx 1 - # #this clause is satisfied - no need to process it for other typealt - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # literalprefix { - # set alt_literals [lsearch -all -inline -index 0 $type_alternatives literal] - # set literals [lmap v $alt_literals {lindex $v 1}] - # set alt_literalprefixes [lsearch -all -inline -index 0 $type_alternatives literalprefix] - # set literalprefixes [lmap v $alt_literalprefixes {lindex $v 1}] - - # dict for {c_idx clauseval} $clauses_dict { - # set e [lindex $clauseval $clausecolumn] - # #this specific literalprefix value not relevant - we're testing against all in the set of typealternates - # #set testval [lindex $typealt 1] - # set match [::tcl::prefix::match -error "" [list {*}$literals {*}$literalprefixes] $e] - # if {$match ne "" && $match ni $literals} { - # lset clause_results $c_idx $a_idx 1 - # #this clause is satisfied - no need to process it for other typealt - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } else { - # set msg "$argclass '$argname' for %caller% requires unambiguous literal prefix match for one of '$literalprefixes' within prefix calculation set:'[list {*}$literals {*}$literalprefixes]'. Received: '$e'" - # #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs]] $msg - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs] msg $msg] - # } - # } - # } - # stringstartswith { - # dict for {c_idx clauseval} $clauses_dict { - # set e [lindex $clauseval $clausecolumn] - # set testval [lindex $typealt 1] - # if {[string match $testval* $e]} { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } else { - # set msg "$argclass '$argname' for %caller% requires stringstartswith value '$testval'. Received: '$e'" - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs] msg $msg] - # } - # } - # } - # stringendswith { - # dict for {c_idx clauseval} $clauses_dict { - # set e [lindex $clauseval $clausecolumn] - # set testval [lindex $typealt 1] - # if {[string match *$testval $e]} { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } else { - # set msg "$argclass '$argname' for %caller% requires stringendswith value '$testval'. Received: '$e'" - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs] msg $msg] - # } - # } - # } - # list { - # dict for {c_idx clauseval_check} $clauses_dict_check { - # set e_check [lindex $clauseval_check $clausecolumn] - # set passed_checks 1 - # if {![tcl::string::is list -strict $e_check]} { - # set msg "$argclass '$argname' for %caller% requires type 'list'. Received: '$e_check'" - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e_check -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } else { - # if {[dict exists $thisarg_checks -minsize]} { - # # -1 for disable is as good as zero - # set minsize [dict get $thisarg_checks -minsize] - # if {[llength $e_check] < $minsize} { - # set msg "$argclass '$argname for %caller% requires list with -minsize $minsize. Received len:[llength $e_check]" - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list sizeviolation $type minsize $minsize] -badarg $e_check -badval $e_check -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } - # if {$passed_checks && [dict exist $thisarg_checks -maxsize]} { - # set maxsize [dict get $thisarg_checks -maxsize] - # if {$maxsize ne "-1"} { - # if {[llength $e_check] > $maxsize} { - # set msg "$argclass '$argname for %caller% requires list with -maxsize $maxsize. Received len:[llength $e_check]" - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list sizeviolation $type maxsize $maxsize] -badarg $e_check -badval $e_check -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } - # } - # } - # if {$passed_checks} { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # indexexpression { - # dict for {c_idx clauseval_check} $clauses_dict_check { - # set e_check [lindex $clauseval_check $clausecolumn] - # if {[catch {lindex {} $e_check}]} { - # set msg "$argclass $argname for %caller% requires type indexexpression. An index as used in Tcl list commands. Received: '$e_check'" - # #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] - # } else { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # string - ansistring - globstring { - # #we may commonly want exceptions that ignore validation rules - most commonly probably the empty string - # #we possibly don't want to always have to regex on things that don't pass the other more basic checks - # # -regexprefail -regexprepass (short-circuiting fail/pass run before all other validations) - # # -regexpostfail -regexpostpass (short-circuiting fail/pass run after other toplevel validations - but before the -validationtransform) - # # in the comon case there should be no need for a tentative -regexprecheck - just use a -regexpostpass instead - # # however - we may want to run -regexprecheck to restrict the values passed to the -validationtransform function - # # -regexpostcheck is equivalent to -regexpostpass at the toplevel if there is no -validationtransform (or if it is in the -validationtransform) - # # If there is a -validationtransform, then -regexpostcheck will either progress to run the -validationtransform if matched, else produce a fail - - # #todo? - way to validate both unstripped and stripped? - # #review - order of -regexprepass and -regexprefail in original rawargs significant? - # #for now -regexprepass always takes precedence - # #REVIEW we only have a single regexprepass/regexprefail for entire typeset?? need to make it a list like -typedefaults? - # set regexprepass [tcl::dict::get $thisarg -regexprepass] - # set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 - # if {$regexprepass ne ""} { - # dict for {c_idx clauseval} $clauses_dict { - # set clauseval_check [dict get $clauses_dict_check $c_idx] - # set e [lindex $clauseval $clausecolumn] - # set e_check [lindex $clauseval_check $clausecolumn] - # if {[regexp [lindex $regexprepass $clausecolumn] $e]} { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # if {$regexprefail ne ""} { - # dict for {c_idx clauseval} $clauses_dict { - # set clauseval_check [dict get $clauses_dict_check $c_idx] - - # set e [lindex $clauseval $clausecolumn] - # set e_check [lindex $clauseval_check $clausecolumn] - # #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 "$argclass $argname for %caller% didn't pass regexprefail regex: '$regexprefail' got '$e'" - # } - # #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $argname -argspecs $argspecs]] $msg - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list regexprefail $type] -badarg $argname -argspecs $argspecs] msg $msg] - # #review - tests? - # } - # } - # } - # switch -- $type { - # ansistring { - # #we need to respect -validate_ansistripped for -minsize etc, but the string must contain ansi - # #.. so we need to look at the original values in $clauses_dict not $clauses_dict_check - - # #REVIEW - difference between string with mixed plaintext and ansi and one required to be ansicodes only?? - # #The ansicodes only case should be covered by -minsize 0 -maxsize 0 combined with -validate_ansistripped ??? - # package require punk::ansi - # dict for {c_idx clauseval} $clauses_dict { - # if {[lindex $clause_results $c_idx $a_idx] ne "_"} { - # continue - # } - # set e [lindex $clauseval $clausecolumn] - # if {![punk::ansi::ta::detect $e]} { - # set msg "$argclass '$argname' for %caller% requires ansistring - but no ansi detected" - # #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] - # } - # } - # } - # globstring { - # dict for {c_idx clauseval} $clauses_dict { - # if {[lindex $clause_results $c_idx $a_idx] ne "_"} { - # continue - # } - # set e [lindex $clauseval $clausecolumn] - # if {![regexp {[*?\[\]]} $e]} { - # set msg "$argclass '$argname' for %caller% requires globstring - but no glob characters detected" - # #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs]] $msg - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] - # } - # } - # } - # } - - # dict for {c_idx clauseval_check} $clauses_dict_check { - # if {[lindex $clause_results $c_idx $a_idx] ne "_"} { - # continue - # } - # if {[tcl::dict::size $thisarg_checks]} { - # set passed_checks 1 - # set e_check [lindex $clauseval_check $clausecolumn] - # if {[dict exists $thisarg_checks -minsize]} { - # set minsize [dict get $thisarg_checks -minsize] - # # -1 for disable is as good as zero - # if {[tcl::string::length $e_check] < $minsize} { - # set msg "$argclass '$argname' for %caller% requires string with -minsize $minsize. 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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list sizeviolation $type] -badarg $argname -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } - # if {$passed_checks && [dict exists $thisarg_checks -maxsize]} { - # set maxsize [dict get $thisarg_checks -maxsize] - # if {$checkval ne "-1"} { - # if {[tcl::string::length $e_check] > $maxsize} { - # set msg "$argclass '$argname' for %caller% requires string with -maxsize $maxsize. 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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list sizeviolation $type] -badarg $argname -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } - # } - # if {$passed_checks} { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } else { - # if {[lindex $clause_results $c_idx $a_idx] eq "_"} { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # } - # number { - # #review - consider effects of Nan and Inf - # #NaN can be considered as 'technically' a number (or at least a special numeric value) - # dict for {c_idx clauseval_check} $clauses_dict_check { - # set e_check [lindex $clauseval_check $clausecolumn] - # if {(![tcl::string::is integer -strict $e_check]) && (![tcl::string::is double -strict $e_check])} { - # set msg "$argclass $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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] - # } - # } - # if {[tcl::dict::exists $thisarg -typeranges]} { - # set ranges [tcl::dict::get $thisarg -typeranges] - # dict for {c_idx clauseval} $clauses_dict { - # set clauseval_check [dict get $clauses_dict_check $c_idx] - # if {[lindex $clause_results $c_idx $a_idx] ne "_"} { - # continue - # } - # set e [lindex $clauseval $clausecolumn] - # set e_check [lindex $clauseval_check $clausecolumn] - # set range [lindex $ranges $clausecolumn] - # lassign {} low high ;#set both empty - # lassign $range low high - # set passed_checks 1 - # if {"$low$high" ne ""} { - # if {[::tcl::mathfunc::isnan $e]} { - # set msg "$argclass '$argname' for %caller% must be an int or double within specified range {'$low' '$high'} NaN not comparable to any range. Received: '$e'" - # #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs]] $msg - # lset clause_results [list errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # if {$passed_checks} { - # if {$low eq ""} { - # if {$e_check > $high} { - # set msg "$argclass '$argname' for %caller% must be an int or double less than or equal to $high. Received: '$e'" - # #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs]] $msg - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } elseif {$high eq ""} { - # if {$e_check < $low} { - # set msg "$argclass '$argname' for %caller% must be an int or double 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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } else { - # if {$e_check < $low || $e_check > $high} { - # set msg "$argclass '$argname' for %caller% must be an int or double between $low and $high inclusive. Received: '$e'" - # #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs]] $msg - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } - # } - # } - # if {$passed_checks} { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict usnet clauses_dict_check $c_idx - # } - # } - # } else { - # dict for {c_idx clauseval} $clauses_dict { - # if {[lindex $clause_results $c_idx $a_idx] ne "_"} { - # continue - # } - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict usnet clauses_dict_check $c_idx - # } - # } - - # } - # int { - # #elements in -typeranges can be expressed as two integers or an integer and an empty string e.g {0 ""} >= 0 or {"" 10} <=10 or {-1 10} -1 to 10 inclusive - # dict for {c_idx clauseval_check} $clauses_dict_check { - # set e_check [lindex $clauseval_check $clausecolumn] - # if {![tcl::string::is integer -strict $e_check]} { - # set msg "$argclass $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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] - # } - # } - # if {[tcl::dict::exists $thisarg -typeranges]} { - # set ranges [tcl::dict::get $thisarg -typeranges] - # dict for {c_idx clauseval} $clauses_dict { - # set clauseval_check [dict get $clauses_dict_check $c_idx] - # if {[lindex $clause_results $c_idx $a_idx] ne "_"} { - # continue - # } - # set e [lindex $clauseval $clausecolumn] - # set e_check [lindex $clauseval_check $clausecolumn] - # set range [lindex $ranges $clausecolumn] - # lassign $range low high - # set passed_checks 1 - # if {"$low$high" ne ""} { - # if {$low eq ""} { - # #lowside unspecified - check only high - # if {$e_check > $high} { - # set msg "$argclass '$argname' for %caller% must be integer less than or equal to $high. Received: '$e'" - # #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs]] $msg - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } elseif {$high eq ""} { - # #highside unspecified - check only low - # if {$e_check < $low} { - # set msg "$argclass '$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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } else { - # #high and low specified - # if {$e_check < $low || $e_check > $high} { - # set msg "$argclass '$argname' for %caller% must be integer between $low and $high inclusive. Received: '$e'" - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } - # } - # if {$passed_checks} { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } else { - # dict for {c_idx clauseval} $clauses_dict { - # if {[lindex $clause_results $c_idx $a_idx] ne "_"} { - # continue - # } - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # double { - # dict for {c_idx clauseval} $clauses_dict { - # set clauseval_check [dict get $clauses_dict_check $c_idx] - # set e_check [lindex $clauseval_check $clausecolumn] - # if {![tcl::string::is double -strict $e_check]} { - # set e [lindex $clauseval $clausecolumn] - # set msg "$argclass $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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] - # } - # } - # if {[tcl::dict::exists $thisarg_checks -typeranges]} { - # set ranges [dict get $thisarg_checks -typeranges] - # dict for {c_idx clauseval} $clauses_dict { - # set clauseval_check [dict get $clauses_dict_check $c_idx] - # if {[lindex $clause_results $c_idx $a_idx] ne "_"} { - # continue - # } - # set e_check [lindex $clauseval_check $clausecolumn] - # set range [lindex $ranges $clausecolumn] - # #todo - small-value double comparisons with error-margin? review - # #todo - empty string for low or high - # set passed_checks 1 - # lassign $range low high - # if {$low$high ne ""} { - # if {$e_check < $low || $e_check > $high} { - # set e [lindex $clauseval $clausecolumn] - # set msg "$argclass $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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } - # if {$passed_checks} { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } else { - # dict for {c_idx clauseval} $clauses_dict { - # if {[lindex $clause_results $c_idx $a_idx] ne "_"} { - # continue - # } - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # bool { - # dict for {c_idx clauseval_check} $clauses_dict_check { - # set e_check [lindex $clauseval_check $clausecolumn] - # if {![tcl::string::is boolean -strict $e_check]} { - # set msg "$argclass $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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] - # } else { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # dict { - # dict for {c_idx clauseval_check} $clauses_dict_check { - # puts "check_clausecolumn2 dict handler: c_idx:$c_idx clausecolumn:$clausecolumn clauseval_check:$clauseval_check" - # set e_check [lindex $clauseval_check $clausecolumn] - # if {[llength $e_check] %2 != 0} { - # set msg "$argclass '$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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -badval $e_check -argspecs $argspecs] msg $msg] - # } - # } - # dict for {c_idx clauseval_check} $clauses_dict_check { - # if {[lindex $clause_results $c_idx $a_idx] ne "_"} { - # continue - # } - # set passed_checks 1 - # if {[tcl::dict::size $thisarg_checks]} { - # if {[dict exists $thisarg_checks -minsize]} { - # set minsizes [dict get $thisarg_checks -minsize] - # set e_check [lindex $clauseval_check $clausecolumn] - # set minsize [lindex $minsizes $clausecolumn] - # # -1 for disable is as good as zero - # if {[tcl::dict::size $e_check] < $minsize} { - # set msg "$argclass '$argname' for %caller% requires dict with -minsize $minsize. Received dict size:[dict size $e_check]" - # #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list sizeviolation $type minsize $minsize] -badarg $argname -badval $e_check -argspecs $argspecs]] $msg - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list sizeviolation $type minsize $minsize] -badarg $argname -badval $e_check -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } - # if {$passed_checks && [dict exists $thisarg_checks -maxsize]} { - # set e_check [lindex $clauseval_check $clausecolumn] - # set maxsize [lindex $maxsizes $clausecolumn] - # if {$maxsize ne "-1"} { - # if {[tcl::dict::size $e_check] > $maxsize} { - # set msg "$argclass '$argname' for %caller% requires dict with -maxsize $maxsize. Received dict size:[dict size $e_check]" - # #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list sizeviolation $type maxsize $maxsize] -badarg $argname -badval $e_check -argspecs $argspecs]] $msg - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list sizeviolation $type maxsize $maxsize] -badarg $argname -badval $e_check -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } - # } - # } - - # if {$passed_checks} { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # alnum - - # alpha - - # ascii - - # control - - # digit - - # graph - - # lower - - # print - - # punct - - # space - - # upper - - # wordchar - - # xdigit { - # dict for {c_idx clauseval} $clauses_dict { - # set clauseval_check [dict get $clauses_dict_check $c_idx] - # set e_check [lindex $clauseval_check $clausecolumn] - # if {![tcl::string::is $type -strict $e_check]} { - # set e [lindex $clauseval $t] - # set msg "$argclass $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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] - # } else { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # file - - # directory - - # existingfile - - # existingdirectory { - # dict for {c_idx clauseval} $clauses_dict { - # set clauseval_check [dict get $clauses_dict_check $c_idx] - - # set e [lindex $clauseval $clausecolumn] - # set e_check [lindex $clauseval_check $clausecolumn] - - # #//review - we may need '?' char on windows - # set passed_checks 1 - # if {!([tcl::string::length $e_check]>0 && ![regexp {[\"*<>\;]} $e_check])} { - # #what about special file names e.g on windows NUL ? - # set msg "$argclass $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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # if {$passed_checks} { - # if {$type eq "existingfile"} { - # if {![file exists $e_check]} { - # set msg "$argclass $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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -badval $e -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } elseif {$type eq "existingdirectory"} { - # if {![file isdirectory $e_check]} { - # set msg "$argclass $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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -badval $e -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } - # } - # if {$passed_checks} { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # char { - # #review - char vs unicode codepoint vs grapheme? - # dict for {c_idx clauseval} $clauses_dict { - # set clauseval_check [dict get $clauses_dict_check $c_idx] - - # set e_check [lindex $clauseval_check $clausecolumn] - # if {[tcl::string::length $e_check] != 1} { - # set e [lindex $clauseval $clausecolumn] - # set msg "$argclass $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 - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -badval $e -argspecs $argspecs] msg $msg] - # } else { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # tk_screen_units { - # dict for {c_idx clauseval} $clauses_dict { - # set clauseval_check [dict get $clauses_dict_check $c_idx] - - # set e_check [lindex $clauseval_check $clausecolumn] - # set passed_checks 1 - # switch -exact -- [string index $e_check end] { - # c - i - m - p { - # set numpart [string range $e_check 0 end-1] - # if {![tcl::string::is double $numpart]} { - # set e [lindex $clauseval $clausecolumn] - # set msg "$argclass $argname for %caller% requires type 'tk_screen_units'. Received: '$e' Which does not seem to be in a form as accepted ty Tk_GetPixels." - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -badval $e -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } - # default { - # if {![tcl::string::is double $e_check]} { - # set e [lindex $clauseval $clausecolumn] - # set msg "$argclass $argname for %caller% requires type 'tk_screen_units'. Received: '$e' Which does not seem to be in a form as accepted ty Tk_GetPixels." - # lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -badval $e -argspecs $argspecs] msg $msg] - # set passed_checks 0 - # } - # } - # } - # if {$passed_checks} { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # default { - # #default pass for unrecognised types - review. - # dict for {c_idx clauseval} $clauses_dict { - # lset clause_results $c_idx $a_idx 1 - # dict unset clauses_dict $c_idx - # dict unset clauses_dict_check $c_idx - # } - # } - # } - # } - # foreach clauseresult $clause_results { - # if {[lsearch $clauseresult 1] == -1} { - # #no pass for this clause - fetch first? error and raise - # #todo - return error containing clause_indices so we can report more than one failing element at once? - # foreach e $clauseresult { - # if {[lindex $e 0] eq "errorcode"} { - # #errorcode msg values + #[para]Parse rawargs as a sequence of zero or more leaders, zero or more options (solo flags, -flag value pairs, mashes, --long=value), and zero or more values + #[para]Returns a dict with keys: leaders opts values received solos multis id form (plus formstatus when multiform candidacy ran) #[para]ARGUMENTS: #[list_begin arguments] #[arg_def list-of-multiline-string deflist] @@ -10351,8 +9251,8 @@ tcl::namespace::eval punk::args { #[para]argumentname -key val -ky2 val2... #[para]where the valid keys for each option specification are: -default -type -range -choices #[para]comment lines begining with # are ignored and can be placed anywhere except within a multiline value where it would become part of that value - #[para]lines beginning with @cmd @leaders @opts or @values also take -key val pairs and can be used to set defaults and control settings. - #[para]@opts or @values lines can appear multiple times with defaults affecting flags/values that follow. + #[para]directive lines beginning with @id @cmd @form @leaders @opts @values @formdisplay @doc @examples (plus bare @dynamic and @normalize) take -key val pairs and set defaults or control settings. + #[para]@leaders @opts and @values lines can appear multiple times with defaults affecting the argument lines that follow. #[arg_def list rawargs] #[para] This is a list of the arguments to parse. Usually it will be the $args value from the containing proc, #but it could be a manually constructed list of values made for example from positional args defined in the proc. @@ -11160,7 +10060,7 @@ tcl::namespace::eval punk::args { lappend multisreceived $api_opt } } else { - #test parse_withdef_parsekey_repeat_ordering {Ensure last flag has precedence} + #2026-07-14 Agent-Updated: pinned by test parsekey_repeat_ordering (tests args/parsekey.test) - last flag must have precedence #tcl::dict::set opts $flag_ident $tdflt if {$flag_ident_is_parsekey} { #(shimmer - but required for ordering correctness during override) @@ -11402,7 +10302,7 @@ tcl::namespace::eval punk::args { lappend multisreceived $api_opt } } else { - #test parse_withdef_parsekey_repeat_ordering {Ensure last flag has precedence} + #2026-07-14 Agent-Updated: pinned by test parsekey_repeat_ordering (tests args/parsekey.test) - last flag must have precedence #tcl::dict::set opts $flag_ident $tdflt if {$flag_ident_is_parsekey} { #(shimmer - but required for ordering correctness during override) @@ -11533,41 +10433,13 @@ tcl::namespace::eval punk::args { } - #set id [dict get $argspecs id] - #if {$id eq "::if"} { - #puts stderr "::if" - #puts stderr "get_dict--> arglist: $arglist" - #puts stderr "get_dict--> leaders: $leaders" - #puts stderr "get_dict--> values: $values" - #} - #--------------------------------------- #Order the received options by the order in which they are *defined* #EXCEPT that grouped options using same parsekey must be processed in received order + #(2026-07-14 Agent-Updated: a superseded simpler ordering loop that ignored + #received-order for shared parsekeys was removed here - see git history pre 0.12.28) set ordered_opts [dict create] - #set unaliased_opts [lmap v $OPT_NAMES {string trimright [lindex [split $v |] end] =}] - ##unaliased_opts is list of 'api_opt' (to handle flag aliases of form -a1|-a2|-api_opt) - ## e.g -fg|-foreground - ## e.g -x|--fullname= - ##Resulting unaliased_opts from list {-fg|-foreground -x|--fullname=} should be {-foreground --fullname} - #foreach o $unaliased_opts optset $OPT_NAMES { - # if {[dict exists $opts $o]} { - # dict set ordered_opts $o [dict get $opts $o] - # } elseif {[dict exists $OPT_DEFAULTS $optset]} { - # #JJJ - # set parsekey "" - # if {[tcl::dict::exists $argstate $o -parsekey]} { - # set parsekey [tcl::dict::get $argstate $o -parsekey] - # } - # if {$parsekey eq ""} { - # set parsekey $o - # } - # dict set ordered_opts $parsekey [dict get $OPT_DEFAULTS $optset] - # } - #} - - #puts ">>>>====opts: $opts" set seen_pks [list] #treating opts as list for this loop. foreach optset $OPT_NAMES { @@ -11673,7 +10545,24 @@ tcl::namespace::eval punk::args { set start_position $positionalidx set nameidx 0 - #MAINTENANCE - (*nearly*?) same loop logic as for value + #------------------------------------------------------------------------------- + #2026-07-14 Agent-Updated (was: "MAINTENANCE - (*nearly*?) same loop logic as for value") + #MAINTENANCE: this leaders loop and the values loop below are deliberate near-clones. + #Shared logic: per-word get_dict_can_assign_value, optional-skip/required-raise on + #consumed==0, clause assembly, -multiple collection, received/typestate bookkeeping, + #-unnamed fallback, and the G-082 alloc_rejections overflow error selection. + #Known asymmetries: interplay with the upstream leader/value split, + #LEADER_TAKEWHENARGSMODULO, missingrequiredleader vs missingrequiredvalue, and the + #values loop's api_valname (-parsekey) identifiers which this loop lacks (G-084). + #Refactor assessment (2026-07-14): folding both loops into one clause-assignment + #helper is indicated - drift is real (G-082 had to duplicate its selection block; + #parsekey idents exist only on the values side) - but it should ride the G-084 + #leaders/values parsekey parity work, which must touch both loops anyway, and must + #respect the parse hot-path constraints established by G-046: naive proc extraction + #means heavy state plumbing (upvar/dict) for many loop-local variables. Until then, + #any edit to one loop must be mirrored in the other or the divergence justified in + #a comment at the point of divergence. + #------------------------------------------------------------------------------- for {set ldridx 0} {$ldridx < [llength $leaders]} {incr ldridx} { set leadername [lindex $LEADER_NAMES $nameidx] set ldr [lindex $leaders $ldridx] @@ -11734,8 +10623,10 @@ tcl::namespace::eval punk::args { # allow any value instead of 'then' to pass. #see argument_clause_typestate in value processing loop below for more handling of this issue regarding -multiple true clauses with optional subelements - #todo - synchronize with value processing loop below - #- consider refactor to a common procedure for handling this issue of tracking updated typelist state for optional subelements in -multiple true clauses + #2026-07-14 Agent-Updated: the "synchronize with the values loop / + #refactor to a common procedure" todo that lived here is subsumed by + #the MAINTENANCE refactor assessment at the head of this leaders loop + #(shared-helper refactor deferred to ride the G-084 parity work). #incorrect -don't update default -type info. #tcl::dict::set argstate $leadername -type $newtypelist ;#(possible ?omitted-? and ?defaulted-? entries @@ -11861,9 +10752,7 @@ tcl::namespace::eval punk::args { set valname_multiple "" set valnames_received [list] - #xxxxxxxxxxxxxxxxxx set api_valnames_received [list] - #xxxxxxxxxxxxxxxxxx set num_values [llength $values] #------------------------------------------ @@ -11881,12 +10770,18 @@ tcl::namespace::eval punk::args { set nameidx 0 set start_position $positionalidx set seen_pks [list] - #MAINTENANCE - (*nearly*?) same loop logic as for leaders + #2026-07-14 Agent-Updated (was: "MAINTENANCE - (*nearly*?) same loop logic as for leaders") + #MAINTENANCE: near-clone of the leaders loop above - see the refactor assessment + #comment there (shared logic, known asymmetries, defer-to-G-084 decision). + #Any edit here must be mirrored in the leaders loop or justified at the divergence. for {set validx 0} {$validx < [llength $values]} {incr validx} { set valname [lindex $VAL_NAMES $nameidx] set val [lindex $values $validx] #---------------------------------- - #todo + #2026-07-14 Agent-Updated (was a bare "#todo"): values/leaders -parsekey + #completeness is goal G-084 - this api_valname derivation is the values-side + #start of it (currently a value's -parsekey aborts parse further on, and the + #leaders loop has no equivalent). set api_valname "" if {[tcl::dict::exists $argstate $valname -parsekey]} { set api_valname [tcl::dict::get $argstate $valname -parsekey] @@ -11907,23 +10802,12 @@ tcl::namespace::eval punk::args { } lappend seen_pks $api_valname #---------------------------------- - #xxxxxxxxxxxxxxxxxxxxx - # if {[tcl::dict::get $argstate $optionset -parsekey] ne ""} { - # set api_opt [dict get $argstate $optionset -parsekey] - # } else { - # set api_opt [string trimright [lindex $raw_optionset_members end] =] - # } - # if {$api_opt eq $flagname} { - # set flag_ident $api_opt - # set flag_ident_is_parsekey 0 - # } else { - # #initially key our opts on a long form allowing us to know which specific flag was used - # #(for when multiple map to same parsekey e.g lsearch) - # #e.g -increasing|-SORTOPTION - # set flag_ident $flagname|$api_opt - # set flag_ident_is_parsekey 1 - # } - #xxxxxxxxxxxxxxxxxxxxx + #2026-07-14 Agent-Updated: a pasted reference copy of the opts-path + #flag_ident/-parsekey logic was removed here (the val_ident derivation + #above is its values-loop analogue). Values/leaders -parsekey support is + #incomplete - see goal G-084 (parse currently errors for a value's + #-parsekey and ignores a leader's). + #---------------------------------- if {$valname ne ""} { set valtypelist [tcl::dict::get $argstate $valname -type] set clause_size [llength $valtypelist] ;#common case is clause_size == 1 @@ -12088,10 +10972,6 @@ tcl::namespace::eval punk::args { } } #----------------------------------------------------- - #JJJJJJ - #if {[dict size $argument_clause_typestate]} { - # puts ">>>>>[dict get $argspecs id] typestate $argument_clause_typestate" - #} if {$leadermax == -1} { #only check min diff --git a/src/modules/punk/args-buildversion.txt b/src/modules/punk/args-buildversion.txt index 04732e9a..f04a9267 100644 --- a/src/modules/punk/args-buildversion.txt +++ b/src/modules/punk/args-buildversion.txt @@ -1,6 +1,7 @@ -0.12.1 +0.12.2 #First line must be a semantic version number #all other lines are ignored. +#0.12.2 - comment/documentation hygiene pass (no behaviour change). Removed ~1100 lines of superseded commented-out code: the old-signature private::check_clausecolumn, the abandoned _check_clausecolumn2 'interim version' experiment (its one keeper idea - collect per-clause validation results and report at end instead of raising on first failure - recorded in an in-place note for G-072-era rework), the pre-parsekey opts ordering loop, a disabled XXXliteral* switch arm in get_dict_can_assign_value's multi-member clause walk (open item noted: literalprefix() members unhandled there), and misc debug remnants. Expanded the leaders/values loop MAINTENANCE notes into a real refactor assessment: shared clause-assignment helper extraction is indicated (drift is real - G-082 duplicated its selection block, parsekey idents exist only values-side) but deferred to ride the G-084 leaders/values parsekey parity work under the G-046 hot-path constraints; until then edits to one loop must be mirrored or justified. Documentation corrections: get_dict PUNKARGS/doctools return shape now lists the real result keys (leaders opts values received solos multis id form + formstatus when candidacy ran); directive lists updated beyond @cmd/@leaders/@opts/@values; removed false pre-modern claims ('only supports -flag val pairs, not solo options', 'only the last value is used'); fixed the broken parse -help example (dict exists bracketing) and the module-header dofilestuff example (stray trailing 1 after -type existingfile); assorted typos. Goal cross-references annotated in code comments (G-053 -multiple occurrence ranges, G-084 values/leaders parsekey, corrected test-name refs to parsekey_repeat_ordering). Flagged (comment only, behaviour unchanged, no pins exist): suspected bug in the multi-member clause stringstartswith( arm - it string-matches against $tp (the type) instead of $rv (the value), so it always takes the success path. #0.12.1 - G-082 single-form parse error selection: a word rejected by an OPTIONAL argument's allocation screen (G-071 restricted-choice screen, or the basic-type screen: int/double/bool/number/dict) that subsequently overflows the argument list now reports the specific rejection - choiceviolation naming the word and the allowed choices (with -badarg/-badval and the same message template as final validation's report for required args), or typemismatch naming the declared type - instead of the generic 'Received more values than can be assigned' toomanyarguments (regression vs 0.5.0 found during G-030 make.tcl dogfooding; the -optional 0 authoring workaround is no longer required). Mechanism: get_dict_can_assign_value returns a 'rejection' record (single-member clauses only; literal-category mismatches deliberately not recorded - overflow stays the clearer report for syntax-word shapes like lseq 'to'), the three allocation call sites (leader/value split trial, leaders loop, values loop) collect first-rejection-per-word into a per-form store, and the two overflow raise sites prefer a recorded rejection for the unassignable word. Genuinely-surplus words (all optionals satisfied) still report toomanyarguments; words consumed by a later slot parse unchanged; multiform selection (rank_form_failures) unchanged - per-form failures just carry the more specific class. New testsuite errorselection.test (characterized pre-fix, pins flipped deliberately). #0.12.0 - G-074: new punk::args::formcheck - on-demand multiform ambiguity analysis. Static pairwise pass over a definition's resolved FORMS: enumerates the positional word-slot chains each form can present (leaders then values, branching on -optional arguments and ?-wrapped optional clause members, -multiple capped; options excluded - order-free), derives candidate witness arglists for aligned equal-length chains (discriminator words + type-derived witnesses, screened via choiceword_match/type tests so screening can't diverge from parse acceptance), and only reports a form pair after CONFIRMING a witness with a real single-form parse against BOTH forms (parse_status; no user-supplied words, nothing added to define/resolve cost) - so fully discriminated pairs cannot false-alarm and every reported witness is a genuine multipleformmatches arglist; the documented miss direction is witness derivation (exotic types, forms requiring options, enumeration caps). Findings classify as type_weakness (a discriminator slot - literal()/literalprefix()/restricted choices - aligned with a permissive non-validating type: any/none/string/ansistring/globstring/expr/script; the 'lseq 1 count 5' class) vs structural (forms genuinely share an argument shape; the 'after cancel id|script' class). New @form key -overlapallowed sanctions a KNOWN overlap on either pair member: the finding reports with sanctioned 1 and leaves the unsanctioned list (the actionable/gate subset) - parse behaviour is never affected (multipleformmatches still raises); unknown form names rejected at definition resolve. Returns machine-parsable dict (id/form_names/pairs/findings with witness+per-slot relations/unsanctioned/summary) or -return summary for the report text. New testsuite formcheck.test; @form directive doc updated. Proving consumers: tclcore ::lseq (reports range/start_count AND range/count - both real, root cause the expr-typed end slot) and ::after (exactly the sanctioned cancelid/cancelscript documented overlap). #0.11.2 - bad-@dynamic warn-once + round-1 caching (user-reported: 'i join' emitted the "bad @dynamic tag" warning 4x, 'i join test' 6x): a @dynamic definition whose round-1 tstr output contains no round-2 parameters previously bypassed argdefcache_unresolved entirely, so EVERY resolve redid display masking plus the full round-1 tstr and re-warned - each 'i' invocation resolves several times (doc walk, advisory parse, get_spec for the render, synopsis), all cache hits for static definitions but full re-work for bad-dynamic ones. Such definitions are now cached as a zero-param unresolved entry: subsequent resolves take the cheap cached branch (consistent with the round-1 freezing legitimately dynamic definitions already get) and the warning emits once per definition per interp. Warning message corrected while there: @dynamic is NOT a complete no-op for a parse-inert definition - deferred display fields still re-expand per render instead of caching (expand_display_fields spec_dynamic gate), so the message now says removal is appropriate only if that display behaviour is unintended. Legitimately dynamic definitions unaffected (round-2 re-substitution pinned live). Also commented the dev diagnostics dump (puts of the full records list + ::testrecord global) on resolve's malformed-record error path - the raised message already carries the offending record; found when the malformed ::tcl_startOfNextWord tclcore definition triggered it (fixed in tclcore 0.3.2). New testsuite args/dynamic.test (warn-once + cached-parse pin, legit-dynamic round-2 freshness pin, stderr captured via channel transform).