diff --git a/CHANGELOG.md b/CHANGELOG.md index b870dae7..ad27d6b8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,15 @@ 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.66.1] - 2026-08-09 + +- punk::args validation errors now display-bound received values (punk::args + 0.26.0, G-151 follow-on): an over-budget or control/ANSI-laden word embedded + in an error message is single-line-ized and truncated with '...' plus its + raw length instead of flowing raw into the render. '@cmd -reportvaluewidth' + caps per definition (default 48); errorcode -badarg/-badval keep the raw + words. Reaches deployed kits at the next bootsupport/vfscommon promotion. + ## [0.66.0] - 2026-08-08 - Kits ship a repaired tcllib: the suite-side pkgindex_gate corrects five diff --git a/goals/archive/G-151-punkargs-annotated-success-render.md b/goals/archive/G-151-punkargs-annotated-success-render.md index fc167522..4ed89261 100644 --- a/goals/archive/G-151-punkargs-annotated-success-render.md +++ b/goals/archive/G-151-punkargs-annotated-success-render.md @@ -169,7 +169,7 @@ Verification evidence: ## Follow-ons Follow-on: make.tcl retires its interim one-line 'dry-run: line accepted ...' report in favour of parse_report (stacked under the usage render per lean 1) after a bootsupport promotion carrying punk::args 0.18.0- and punk::ansi 0.2.0- => open -Follow-on: serve arg_error's failure-side value-truncation todo ('truncate/summarize values in error messages', args-999999.0a1.0.tm arg_error region) with the same report_display_value/TRUNCATE helpers (lean 5 - explicitly excluded from this goal's acceptance) => open +Follow-on: serve arg_error's failure-side value-truncation todo ('truncate/summarize values in error messages', args-999999.0a1.0.tm arg_error region) with the same report_display_value/TRUNCATE helpers (lean 5 - explicitly excluded from this goal's acceptance) => landed 2026-08-09 (punk::args 0.26.0 private::error_display_value - all received-word message sites incl unexpected-option words; '@cmd -reportvaluewidth' cascade; raw -badarg/-badval retained; validation.test pins) Follow-on: engine-level rationalization of parse-result storage keys vs definition argument names (aliased optionset last-|-member fold, -parsekey renames) so value-in-effect lookups need no display-level bridging => goal G-084 Follow-on: column-aware (display-width) TRUNCATE variant for CJK-heavy values (the grapheme-count cap under-counts double-wide content; noted in the TRUNCATE argdoc) => open Follow-on: word-oriented inverse view (word -> consuming argument, e.g a -return words variant) as completion/hinting-facing data - lean 1 records it as a possible later variant, not the primary => open diff --git a/punkproject.toml b/punkproject.toml index d717467f..cdc8d381 100644 --- a/punkproject.toml +++ b/punkproject.toml @@ -1,6 +1,6 @@ [project] name = "punkshell" -version = "0.66.0" +version = "0.66.1" license = "BSD-2-Clause" url = "https://www.gitea1.intx.com.au/jn/punkshell" #packager: declared identity for published artifacts (declarative, not proof - diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index a72cb23d..5c1a7b3e 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/src/modules/punk/args-999999.0a1.0.tm @@ -817,6 +817,12 @@ tcl::namespace::eval punk::args { 0 means no cap. Callers of parse_report may override with its -valuewidth option; with neither present the built-in default (48) applies. + The same cap bounds the display of received values + embedded in this definition's validation error + messages: an over-budget value is single-line-ized + and truncated with '...' plus its raw length, while + the raw value still travels machine-facing in the + errorcode (-badval where applicable). %B%@leaders%N% ?opt val...? (used for leading args that come before switches/opts) directive-options: @@ -8967,6 +8973,39 @@ tcl::namespace::eval punk::args { return [list $shown [llength $shown]] } + #G-151 follow-on: bounded display of a received value embedded in a validation + #error message - the same machinery as parse_report's value cells + #(report_display_value, string mode: single-line-ize via ansistring VIEW, then + #grapheme-cap with '...' + ' (len N)'). Elision is display-only: the raw value + #still travels machine-facing in the errorcode (-badval where the site provides + #it). Width: definition-level '@cmd -reportvaluewidth' > built-in 48; 0 = no cap. + #Fast path: check_clausecolumn builds candidate messages for type alternatives + #that may never be raised, so a value that provably displays as itself (within + #budget, no C0/C1/DEL content for the single-line-ization to transform) returns + #without invoking the ansistring machinery. + proc private::error_display_value {value argspecs} { + set budget [Dict_getdef $argspecs cmd_info -reportvaluewidth 48] + if {![tcl::string::is integer -strict $budget] || $budget < 0} {set budget 48} + if {($budget == 0 || [tcl::string::length $value] <= $budget) && ![regexp {[\x00-\x1F\x7F-\x9F]} $value]} { + return $value + } + if {[catch {report_display_value $value string $budget} disp]} { + #degraded path: an error message must never die on its display helper. + #Known instance: punk::ansi loaded without its punk::lib dependency - + #ansistring TRUNCATE dies in RANGE (punk::lib::lindex_resolve) until some + #later render loads punk::lib. Use the same plain fallbacks + #report_display_value uses when ansistring is absent (has_ansistring 0). + set disp [Report_singleline $value 0] + if {$budget > 0 && [tcl::string::length $disp] > $budget} { + set lenmark " (len [tcl::string::length $value])" + set cap [expr {$budget - [tcl::string::length $lenmark]}] + if {$cap < 1} {set cap 1} + set disp [Report_truncate $disp $cap 0]$lenmark + } + } + return $disp + } + #return number of values we can assign to cater for variable length clauses such as: # {"elseif" expr "?then?" body} #review - efficiency? each time we call this - we are looking ahead at the same info @@ -9698,7 +9737,7 @@ tcl::namespace::eval punk::args { switch -exact -- $type { literal { if {$e ne $testval} { - set msg "$argclass '$argname' for %caller% requires literal value '$testval'. Received: '$e'" + set msg "$argclass '$argname' for %caller% requires literal value '$testval'. Received: '[private::error_display_value $e $argspecs]'" 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 @@ -9714,7 +9753,7 @@ tcl::namespace::eval punk::args { #this clause is satisfied - no need to process it for other typealt break } 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'" + set msg "$argclass '$argname' for %caller% requires unambiguous literal prefix match for one of '$literalprefixes' within prefix calculation set:'[list {*}$literals {*}$literalprefixes]'. Received: '[private::error_display_value $e $argspecs]'" #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] } @@ -9724,7 +9763,7 @@ tcl::namespace::eval punk::args { lset clause_results $c_idx $a_idx 1 break } else { - set msg "$argclass '$argname' for %caller% requires stringstartswith value '$testval'. Received: '$e'" + set msg "$argclass '$argname' for %caller% requires stringstartswith value '$testval'. Received: '[private::error_display_value $e $argspecs]'" lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs] msg $msg] } } @@ -9733,13 +9772,13 @@ tcl::namespace::eval punk::args { lset clause_results $c_idx $a_idx 1 break } else { - set msg "$argclass '$argname' for %caller% requires stringendswith value '$testval'. Received: '$e'" + set msg "$argclass '$argname' for %caller% requires stringendswith value '$testval'. Received: '[private::error_display_value $e $argspecs]'" lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e -argspecs $argspecs] msg $msg] } } list { if {![tcl::string::is list -strict $e_check]} { - set msg "$argclass '$argname' for %caller% requires type 'list'. Received: '$e_check'" + set msg "$argclass '$argname' for %caller% requires type 'list'. Received: '[private::error_display_value $e_check $argspecs]'" lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $e_check -argspecs $argspecs] msg $msg] continue } else { @@ -9768,7 +9807,7 @@ tcl::namespace::eval punk::args { } regex - regexp { if {[catch {regexp -about -- $e_check} re_about_msg]} { - set msg "$argclass $argname for %caller% requires type regexp. $re_about_msg. Received: '$e_check'" + set msg "$argclass $argname for %caller% requires type regexp. $re_about_msg. Received: '[private::error_display_value $e_check $argspecs]'" lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] } else { #optional -mincap and -maxcap specify number of allowed subexpressions(capture groups) present in regex @@ -9790,7 +9829,7 @@ tcl::namespace::eval punk::args { if {$maxcap == -1} { #unlimited maxcap - just check mincap if {$num_caps < $mincap} { - set msg "$argclass $argname for %caller% requires type regexp with at least $mincap capture groups. Received regex has only $num_caps capture groups. Regex: '$e_check'" + set msg "$argclass $argname for %caller% requires type regexp with at least $mincap capture groups. Received regex has only $num_caps capture groups. Regex: '[private::error_display_value $e_check $argspecs]'" 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 @@ -9798,10 +9837,10 @@ tcl::namespace::eval punk::args { } } else { if {$num_caps < $mincap} { - set msg "$argclass $argname for %caller% requires type regexp with at least $mincap capture groups. Received regex has only $num_caps capture groups. Regex: '$e_check'" + set msg "$argclass $argname for %caller% requires type regexp with at least $mincap capture groups. Received regex has only $num_caps capture groups. Regex: '[private::error_display_value $e_check $argspecs]'" lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] } elseif {$num_caps > $maxcap} { - set msg "$argclass $argname for %caller% requires type regexp with no more than $maxcap capture groups. Received regex has $num_caps capture groups. Regex: '$e_check'" + set msg "$argclass $argname for %caller% requires type regexp with no more than $maxcap capture groups. Received regex has $num_caps capture groups. Regex: '[private::error_display_value $e_check $argspecs]'" 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 @@ -9814,7 +9853,7 @@ tcl::namespace::eval punk::args { indexexpression { #tcl 9.1+? tip 615 'string is index' if {$e_check eq "" || [catch {lindex {} $e_check}]} { - set msg "$argclass $argname for %caller% requires type indexexpression. An index as used in Tcl list commands. Received: '$e_check'" + set msg "$argclass $argname for %caller% requires type indexexpression. An index as used in Tcl list commands. Received: '[private::error_display_value $e_check $argspecs]'" #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 { @@ -9824,7 +9863,7 @@ tcl::namespace::eval punk::args { } indexset { if {![punk::lib::is_indexset $e_check]} { - set msg "$argclass $argname for %caller% requires type indexset. A comma-delimited set of indexes or index-ranges separated by '..' Received: '$e_check'" + set msg "$argclass $argname for %caller% requires type indexset. A comma-delimited set of indexes or index-ranges separated by '..' Received: '[private::error_display_value $e_check $argspecs]'" 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 @@ -9833,7 +9872,7 @@ tcl::namespace::eval punk::args { } packageversion { if {[catch {::package vsatisfies $e_check $e_check}]} { - set msg "$argclass $argname for %caller% requires type packageversion. A package version number as understood by 'package vsatifies'. Received: '$e_check'" + set msg "$argclass $argname for %caller% requires type packageversion. A package version number as understood by 'package vsatifies'. Received: '[private::error_display_value $e_check $argspecs]'" 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 @@ -9843,7 +9882,7 @@ tcl::namespace::eval punk::args { packagerequirement { set parts [split $e_check -] if {[llength $parts] > 2} { - set msg "$argclass $argname for %caller% requires type packagerequirement. (form min min- or min-max) Received: '$e_check'" + set msg "$argclass $argname for %caller% requires type packagerequirement. (form min min- or min-max) Received: '[private::error_display_value $e_check $argspecs]'" lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] continue } @@ -9863,7 +9902,7 @@ tcl::namespace::eval punk::args { set v_ok 1 ;#default assumption foreach vcheck $vchecklist { if {[catch {::package vsatisfies $vcheck $vcheck}]} { - set msg "$argclass $argname for %caller% requires type packagerequirement. (from min min- or min-max) . Received: '$e_check'" + set msg "$argclass $argname for %caller% requires type packagerequirement. (from min min- or min-max) . Received: '[private::error_display_value $e_check $argspecs]'" lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname -argspecs $argspecs] msg $msg] set v_ok 0 break ;#inner loop @@ -9903,7 +9942,7 @@ tcl::namespace::eval punk::args { #review - %caller% ?? set msg [tcl::dict::get $thisarg -regexprefailmsg] } else { - set msg "$argclass $argname for %caller% didn't pass regexprefail regex: '$regexprefail' got '$e'" + set msg "$argclass $argname for %caller% didn't pass regexprefail regex: '$regexprefail' got '[private::error_display_value $e $argspecs]'" } #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] @@ -9941,7 +9980,7 @@ tcl::namespace::eval punk::args { 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'" + set msg "$argclass '$argname' for %caller% requires string with -minsize $minsize. Received len:[tcl::string::length $e_check] value:'[private::error_display_value $e_check $argspecs]'" #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] continue @@ -9951,7 +9990,7 @@ tcl::namespace::eval punk::args { set maxsize [dict get $thisarg_checks -maxsize] if {$maxsize 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'" + set msg "$argclass '$argname' for %caller% requires string with -maxsize $maxsize. Received len:[tcl::string::length $e_check] value:'[private::error_display_value $e_check $argspecs]'" #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] continue @@ -9966,7 +10005,7 @@ tcl::namespace::eval punk::args { #review - consider effects of Nan and Inf #NaN can be considered as 'technically' a number (or at least a special numeric value) 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'" + set msg "$argclass $argname for %caller% requires type integer. Received: '[private::error_display_value $e_check $argspecs]'" #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] continue @@ -9978,28 +10017,28 @@ tcl::namespace::eval punk::args { 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'" + set msg "$argclass '$argname' for %caller% must be an int or double within specified range {'$low' '$high'} NaN not comparable to any range. Received: '[private::error_display_value $e $argspecs]'" #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] continue } 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'" + set msg "$argclass '$argname' for %caller% must be an int or double less than or equal to $high. Received: '[private::error_display_value $e $argspecs]'" #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] continue } } 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'" + set msg "$argclass '$argname' for %caller% must be an int or double greater than or equal to $low. Received: '[private::error_display_value $e $argspecs]'" #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] continue } } 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'" + set msg "$argclass '$argname' for %caller% must be an int or double between $low and $high inclusive. Received: '[private::error_display_value $e $argspecs]'" #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] continue @@ -10013,7 +10052,7 @@ tcl::namespace::eval punk::args { 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 if {![tcl::string::is integer -strict $e_check]} { - set msg "$argclass $argname for %caller% requires type integer. Received: '$e_check'" + set msg "$argclass $argname for %caller% requires type integer. Received: '[private::error_display_value $e_check $argspecs]'" #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] continue @@ -10026,7 +10065,7 @@ tcl::namespace::eval punk::args { 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'" + set msg "$argclass '$argname' for %caller% must be integer less than or equal to $high. Received: '[private::error_display_value $e $argspecs]'" #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] continue @@ -10034,7 +10073,7 @@ tcl::namespace::eval punk::args { } 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'" + set msg "$argclass '$argname' for %caller% must be integer greater than or equal to $low. Received: '[private::error_display_value $e $argspecs]'" #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] continue @@ -10042,7 +10081,7 @@ tcl::namespace::eval punk::args { } 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'" + set msg "$argclass '$argname' for %caller% must be integer between $low and $high inclusive. Received: '[private::error_display_value $e $argspecs]'" lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs] msg $msg] continue } @@ -10054,7 +10093,7 @@ tcl::namespace::eval punk::args { } double { if {![tcl::string::is double -strict $e_check]} { - set msg "$argclass $argname for %caller% requires type double. Received: '$e'" + set msg "$argclass $argname for %caller% requires type double. Received: '[private::error_display_value $e $argspecs]'" #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] continue @@ -10068,19 +10107,19 @@ tcl::namespace::eval punk::args { if {$low eq ""} { #lowside unspecified - check only high if {$e_check > $high} { - set msg "$argclass $argname for %caller% must be double less than or equal to $high. Received: '$e'" + set msg "$argclass $argname for %caller% must be double less than or equal to $high. Received: '[private::error_display_value $e $argspecs]'" lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs] msg $msg] continue } } elseif {$high eq ""} { #highside unspecified - check only low if {$e_check < $low} { - set msg "$argclass $argname for %caller% must be double greater than or equal to $low. Received: '$e'" + set msg "$argclass $argname for %caller% must be double greater than or equal to $low. Received: '[private::error_display_value $e $argspecs]'" lset clause_results $c_idx $a_idx [list errorcode [list PUNKARGS VALIDATION [list rangeviolation $type] -badarg $argname -argspecs $argspecs] msg $msg] continue } } elseif {$e_check < $low || $e_check > $high} { - set msg "$argclass $argname for %caller% must be double between $low and $high. Received: '$e'" + set msg "$argclass $argname for %caller% must be double between $low and $high. Received: '[private::error_display_value $e $argspecs]'" #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] continue @@ -10092,7 +10131,7 @@ tcl::namespace::eval punk::args { } bool { if {![tcl::string::is boolean -strict $e_check]} { - set msg "$argclass $argname for %caller% requires type boolean. Received: '$e_check'" + set msg "$argclass $argname for %caller% requires type boolean. Received: '[private::error_display_value $e_check $argspecs]'" #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] continue @@ -10104,7 +10143,7 @@ tcl::namespace::eval punk::args { dict { #to maintain support for tcl 8.6 - can't directly use 'string is dict' if {![punk::args::lib::string_is_dict $e_check]} { - set msg "$argclass '$argname' for %caller% requires type 'dict' - must be key value pairs. Received: '$e_check'" + set msg "$argclass '$argname' for %caller% requires type 'dict' - must be key value pairs. Received: '[private::error_display_value $e_check $argspecs]'" lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] continue } @@ -10149,7 +10188,7 @@ tcl::namespace::eval punk::args { xdigit { #todo - combined types xdigit && lower ?? set-theoretic types? how? if {![tcl::string::is $type -strict $e_check]} { - set msg "$argclass $argname for %caller% requires type '$type'. Received: '$e'" + set msg "$argclass $argname for %caller% requires type '$type'. Received: '[private::error_display_value $e $argspecs]'" lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] continue } else { @@ -10162,7 +10201,7 @@ tcl::namespace::eval punk::args { directory { #see comments in existingpath/existingfile/existingdirectory case about the challenges of validating filesystem paths in a general way that works across platforms and use cases. if {[tcl::string::length $e_check]==0 || [string first \0 $e_check] >= 0} { - set msg "$argclass $argname for %caller% requires type '$type'. Received: '$e' which doesn't look like it could be a path, file or directory" + set msg "$argclass $argname for %caller% requires type '$type'. Received: '[private::error_display_value $e $argspecs]' which doesn't look like it could be a path, file or directory" lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] continue } @@ -10187,7 +10226,7 @@ tcl::namespace::eval punk::args { #NUL is almost universally problematic - so we will reject. if {[tcl::string::length $e_check]==0 || [string first \0 $e_check] >= 0} { - set msg "$argclass $argname for %caller% requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" + set msg "$argclass $argname for %caller% requires type '$type'. Received: '[private::error_display_value $e $argspecs]' which doesn't look like it could be a file or directory" lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] continue } @@ -10210,21 +10249,21 @@ tcl::namespace::eval punk::args { switch -exact -- $type { existingpath { if {![file exists $e_check]} { - set msg "$argclass $argname for %caller% requires type '$type'. Received: '$e' which is not an existing path" + set msg "$argclass $argname for %caller% requires type '$type'. Received: '[private::error_display_value $e $argspecs]' which is not an existing path" lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] continue } } existingfile { if {![file isfile $e_check]} { - set msg "$argclass $argname for %caller% requires type '$type'. Received: '$e' which is not an existing file" + set msg "$argclass $argname for %caller% requires type '$type'. Received: '[private::error_display_value $e $argspecs]' which is not an existing file" lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] continue } } existingdirectory { if {![file isdirectory $e_check]} { - set msg "$argclass $argname for %caller% requires type '$type'. Received: '$e' which is not an existing directory" + set msg "$argclass $argname for %caller% requires type '$type'. Received: '[private::error_display_value $e $argspecs]' which is not an existing directory" lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] continue } @@ -10242,19 +10281,19 @@ tcl::namespace::eval punk::args { #what about windows specific paths such as //?/ //./ or UNC paths? if {[tcl::string::length $e_check]==0 || [string first \0 $e_check] >= 0 || [punk::winpath::illegalname_test $e_check]} { - set msg "$argclass $argname for %caller% requires type '$type'. Received: '$e' which doesn't look like it could be a portable file or directory (must pass punk::winpath::illegalname_test)" + set msg "$argclass $argname for %caller% requires type '$type'. Received: '[private::error_display_value $e $argspecs]' which doesn't look like it could be a portable file or directory (must pass punk::winpath::illegalname_test)" lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] continue } if {$type eq "existingportablefile"} { if {![file exists $e_check]} { - set msg "$argclass $argname for %caller% requires type '$type'. Received: '$e' which is not an existing file" + set msg "$argclass $argname for %caller% requires type '$type'. Received: '[private::error_display_value $e $argspecs]' which is not an existing file" lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] continue } } elseif {$type eq "existingportabledirectory"} { if {![file isdirectory $e_check]} { - set msg "$argclass $argname for %caller% requires type '$type'. Received: '$e' which is not an existing directory" + set msg "$argclass $argname for %caller% requires type '$type'. Received: '[private::error_display_value $e $argspecs]' which is not an existing directory" lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] continue } @@ -10264,7 +10303,7 @@ tcl::namespace::eval punk::args { char { #review - char vs unicode codepoint vs grapheme? if {[tcl::string::length $e_check] != 1} { - set msg "$argclass $argname for %caller% requires type 'character'. Received: '$e' which is not a single character" + set msg "$argclass $argname for %caller% requires type 'character'. Received: '[private::error_display_value $e $argspecs]' which is not a single character" lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] continue } else { @@ -10277,14 +10316,14 @@ tcl::namespace::eval punk::args { c - i - m - p { set numpart [string range $e_check 0 end-1] if {![tcl::string::is double $numpart]} { - 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." + set msg "$argclass $argname for %caller% requires type 'tk_screen_units'. Received: '[private::error_display_value $e $argspecs]' Which does not seem to be in a form as accepted ty Tk_GetPixels." lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] continue } } default { if {![tcl::string::is double $e_check]} { - 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." + set msg "$argclass $argname for %caller% requires type 'tk_screen_units'. Received: '[private::error_display_value $e $argspecs]' Which does not seem to be in a form as accepted ty Tk_GetPixels." lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] continue } @@ -11964,9 +12003,9 @@ tcl::namespace::eval punk::args { lappend flagsreceived $undefined_flagsupplied ;#adhoc flag name (if --x=1 -> --x) } else { if {[llength $OPT_NAMES]} { - set errmsg "bad options for %caller%. Unexpected option \"$a\": must be one of: $OPT_NAMES (3)" + set errmsg "bad options for %caller%. Unexpected option \"[private::error_display_value $a $argspecs]\": must be one of: $OPT_NAMES (3)" } else { - set errmsg "bad options for %caller%. Unexpected option \"$a\": No options defined while @opts -any|-arbitrary false" + set errmsg "bad options for %caller%. Unexpected option \"[private::error_display_value $a $argspecs]\": No options defined while @opts -any|-arbitrary false" } 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 $optionset @@ -12169,7 +12208,7 @@ tcl::namespace::eval punk::args { #pointed typemismatch instead of the generic shortfall. if {$rj ne "" && [dict get $rj kind] eq "type" && [dict get $rj argname] eq $leadername} { set rj_type [dict get $rj type] - set msg "Leading argument '$leadername' for %caller% requires type '$rj_type'. Received: '$ldr'" + set msg "Leading argument '$leadername' for %caller% requires type '$rj_type'. Received: '[private::error_display_value $ldr $argspecs]'" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $rj_type] -badarg $leadername -badval $ldr -argspecs $argspecs]] $msg } #puts stderr "private::get_dict_can_assign_value $ldridx $values $nameidx $VAL_NAMES" @@ -12247,7 +12286,7 @@ tcl::namespace::eval punk::args { foreach t $leadertypelist { incr ldridx if {$ldridx > [llength $leaders]-1} { - set msg "Bad number of leaders for %caller%. Received [llength $clauseval] values ('$clauseval') for '$leadername_multiple', but requires up to [llength $leadertypelist] values." + set msg "Bad number of leaders for %caller%. Received [llength $clauseval] values ('[private::error_display_value $clauseval $argspecs]') for '$leadername_multiple', but requires up to [llength $leadertypelist] values." return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list clausevaluelength [llength $clauseval] clauselength [llength $leadertypelist] ] -argspecs $argspecs]] $msg } lappend clauseval [lindex $leaders $ldridx] @@ -12286,7 +12325,7 @@ tcl::namespace::eval punk::args { set rj_prefixmsg "" } set rj_choices [dict get $rj choices] - set msg "$rj_argclass '$rj_argname' for %caller% must be one of the listed values:\n [join $rj_choices "\n "]\n$rj_casemsg$rj_prefixmsg. Received: '$ldr'" + set msg "$rj_argclass '$rj_argname' for %caller% must be one of the listed values:\n [join $rj_choices "\n "]\n$rj_casemsg$rj_prefixmsg. Received: '[private::error_display_value $ldr $argspecs]'" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choiceviolation $ldr choices $rj_choices] -badarg $rj_argname -badval $ldr -argspecs $argspecs]] $msg } elseif {[dict get $rj kind] eq "unavailable"} { #G-073: recognised-but-unavailable landing recorded by the @@ -12300,11 +12339,11 @@ tcl::namespace::eval punk::args { #occurrence limit (same errorcode class as post-loop #enforcement; count is the attempted occurrence) set rj_max [dict get $rj max] - set msg "$rj_argclass '$rj_argname' for %caller% accepts at most $rj_max occurrence(s). Received extra word: '$ldr'" + set msg "$rj_argclass '$rj_argname' for %caller% accepts at most $rj_max occurrence(s). Received extra word: '[private::error_display_value $ldr $argspecs]'" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list occurrencecount $rj_argname count [expr {$rj_max + 1}] max $rj_max] -badarg $rj_argname -badval $ldr -argspecs $argspecs]] $msg } else { set rj_type [dict get $rj type] - set msg "$rj_argclass '$rj_argname' for %caller% requires type '$rj_type'. Received: '$ldr'" + set msg "$rj_argclass '$rj_argname' for %caller% requires type '$rj_type'. Received: '[private::error_display_value $ldr $argspecs]'" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $rj_type] -badarg $rj_argname -badval $ldr -argspecs $argspecs]] $msg } } @@ -12430,7 +12469,7 @@ tcl::namespace::eval punk::args { #no rejection, so those shapes keep the shortfall report. if {$rj ne "" && [dict get $rj kind] eq "type" && [dict get $rj argname] eq $valname} { set rj_type [dict get $rj type] - set msg "Trailing argument '$valname' for %caller% requires type '$rj_type'. Received: '$val'" + set msg "Trailing argument '$valname' for %caller% requires type '$rj_type'. Received: '[private::error_display_value $val $argspecs]'" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $rj_type] -badarg $valname -badval $val -argspecs $argspecs]] $msg } #puts stderr "private::get_dict_can_assign_value $validx $values $nameidx $VAL_NAMES" @@ -12550,7 +12589,7 @@ tcl::namespace::eval punk::args { set rj_prefixmsg "" } set rj_choices [dict get $rj choices] - set msg "$rj_argclass '$rj_argname' for %caller% must be one of the listed values:\n [join $rj_choices "\n "]\n$rj_casemsg$rj_prefixmsg. Received: '$val'" + set msg "$rj_argclass '$rj_argname' for %caller% must be one of the listed values:\n [join $rj_choices "\n "]\n$rj_casemsg$rj_prefixmsg. Received: '[private::error_display_value $val $argspecs]'" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choiceviolation $val choices $rj_choices] -badarg $rj_argname -badval $val -argspecs $argspecs]] $msg } elseif {[dict get $rj kind] eq "unavailable"} { #G-073: recognised-but-unavailable landing recorded by the @@ -12566,11 +12605,11 @@ tcl::namespace::eval punk::args { #enforcement; count is the attempted occurrence) #(MAINTENANCE - same selection logic as leaders loop above) set rj_max [dict get $rj max] - set msg "$rj_argclass '$rj_argname' for %caller% accepts at most $rj_max occurrence(s). Received extra word: '$val'" + set msg "$rj_argclass '$rj_argname' for %caller% accepts at most $rj_max occurrence(s). Received extra word: '[private::error_display_value $val $argspecs]'" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list occurrencecount $rj_argname count [expr {$rj_max + 1}] max $rj_max] -badarg $rj_argname -badval $val -argspecs $argspecs]] $msg } else { set rj_type [dict get $rj type] - set msg "$rj_argclass '$rj_argname' for %caller% requires type '$rj_type'. Received: '$val'" + set msg "$rj_argclass '$rj_argname' for %caller% requires type '$rj_type'. Received: '[private::error_display_value $val $argspecs]'" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $rj_type] -badarg $rj_argname -badval $val -argspecs $argspecs]] $msg } } @@ -12856,7 +12895,9 @@ tcl::namespace::eval punk::args { #--------------------------------------------------------------------------------------------- - #todo - truncate/summarize values in error messages + #Received values embedded in validation error messages are display-bounded via + #private::error_display_value (G-151 follow-on): single-line-ized and capped per + #'@cmd -reportvaluewidth' (default 48). Raw values still travel in -badval. #todo - allow defaults outside of choices/ranges @@ -13247,7 +13288,7 @@ tcl::namespace::eval punk::args { lappend longermatches_display "$cu_lm (recognised but unavailable)" } if {[llength $longermatches] || [llength $longermatches_unavail] > 1} { - set msg "$argclass '$argname' for %caller% seems to be an ambiguous prefix. Try one of:\n [join $longermatches_display "\n "]\n$casemsg$prefixmsg. Received: '$c_check'" + set msg "$argclass '$argname' for %caller% seems to be an ambiguous prefix. Try one of:\n [join $longermatches_display "\n "]\n$casemsg$prefixmsg. Received: '[private::error_display_value $c_check $argspecs]'" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choiceviolation $c choices $allchoices] -badarg $argname -badval $c_check -argspecs $argspecs]] $msg } } else { @@ -13256,7 +13297,7 @@ tcl::namespace::eval punk::args { #review: $c vs $c_check for -badval? - set msg "$argclass '$argname' for %caller% must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$c_check'" + set msg "$argclass '$argname' for %caller% must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '[private::error_display_value $c_check $argspecs]'" 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 } @@ -13356,7 +13397,7 @@ tcl::namespace::eval punk::args { foreach clause_value $vlist { foreach e $clause_value { if {[punk::ansi::ta::detect $e]} { - set msg "$argclass '$argname' for %caller% contains ansi - but -allow_ansi is false. character-view: '[punk::ansi::ansistring VIEW $e]'" + set msg "$argclass '$argname' for %caller% contains ansi - but -allow_ansi is false. character-view: '[private::error_display_value $e $argspecs]'" return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list contentviolation ansi] -badarg $argname -argspecs $argspecs]] $msg } } diff --git a/src/modules/punk/args-buildversion.txt b/src/modules/punk/args-buildversion.txt index 202e0a0b..46228c7b 100644 --- a/src/modules/punk/args-buildversion.txt +++ b/src/modules/punk/args-buildversion.txt @@ -1,6 +1,7 @@ -0.25.2 +0.26.0 #First line must be a semantic version number #all other lines are ignored. +#0.26.0 - G-151 follow-on (failure-side value truncation - the 'truncate/summarize values in error messages' engine todo): received values embedded in validation error messages are now display-bounded via new private::error_display_value - the same report_display_value/ansistring TRUNCATE machinery as parse_report's value cells (string mode: single-line-ize via ansistring VIEW -lf 1 -vt 1 -sp 0 so controls/ANSI render visibly, then grapheme-cap with trailing '...' plus ' (len N)' citing the raw length). Applied at every site interpolating a received word into a message: the check_clausecolumn type/size/range/regexprefail reports, the leaders/values allocation-rejection reports (typemismatch/choiceviolation/occurrence overflow incl the multi-value clause echo), the final-validation choiceviolation/ambiguous-prefix reports, the -allow_ansi character-view (previously unbounded ansistring VIEW), and the Unexpected-option unknown-flag word. Width cascade: definition-level '@cmd -reportvaluewidth' > built-in 48; 0 = no cap (define -help documents the extension). Display-only: -badarg/-badval in errorcodes keep the raw words. A short plain value (within budget, no C0/C1/DEL content) displays byte-identical via a cheap fast path - all existing message pins unchanged - and the helper degrades to the plain (non-ansistring) fallbacks if the display machinery itself errors (known window: punk::ansi loaded without punk::lib - ansistring TRUNCATE dies in RANGE until a later render loads punk::lib; an error message must never die on its display helper). New validation.test pins: long-value truncation + raw -badval retention, multiline single-line-ization, @cmd -reportvaluewidth cap, unexpected-option word truncation + raw -badarg retention. Full punk/args suite 415/0 on tclsh90 (9.0.5) and tclsh86. #0.25.2 - bugfix (reported 2026-08-08 as 'i ::tcl::prefix' emitting 12x 'warning: update_definitions received unqualified ns: tcl'): ensemble_subcommands_definition now normalizes its ensemble argument to fully-qualified in the CALLER's context (namespace which via uplevel, :: prepend fallback for a not-yet-existing command) before deriving anything from it. Previously a relative multi-component name (the tclcore moduledoc passed 'tcl::prefix') flowed into the space-form id_checks, whose 'namespace qualifiers' derivation produced a non-empty UNQUALIFIED namespace ('tcl') that the empty-qualifier guard did not catch - update_definitions then warned on stderr once per subcommand per call (and @dynamic definitions re-run their builders on every resolve: 4 resolves x 3 subcommands = the reported 12). Single-component ensemble names (info/dict/file/...) were never affected (empty qualifier -> :: guard). Rendered output verified byte-identical for both name forms. The tclcore moduledoc call site now passes ::tcl::prefix as well (tclcore 0.4.2). Pin: ensembledef.test ensembledef_unqualified_ensemble_name_no_warnings (fixture two-component ensemble called unqualified: zero warnings + snippet parity with the qualified call). #0.25.1 - bugfix: the -type regex|regexp validator's 'regexp -about' lacked its -- end-of-options guard, so a legitimate dash-led regex VALUE (e.g '-group', a valid ARE matching its literal self) was falsely rejected as 'requires type regexp' with regexp's own bad-option text embedded as the reason. Dash-led regexes now validate; a genuinely invalid dash-led regex still fails as a type mismatch with the real compile reason. Found via the 2026-08-08 grepstr dash-led pattern regression report (punk::ansi 0.2.1 carries the sibling 'regexp -about' fix in grepstr itself; the parse/allocation layer was verified NOT at fault). New validation.test pins: type_regexp_dashled_value (accept + real-reason-reject) and opt_dashword_seats_when_values_require_it (the starved-values dash-led seating rule grepstr relies on - no -- marker needed when word supply equals required-values demand). #0.25.0 - G-053 allocation participation (directed work, post-G-053): bounded -multiple occurrence ranges now PARTICIPATE in positional allocation for leaders and values instead of being post-loop enforcement only. Previously greedy collection overran a bounded max unless a type screen happened to stop it (untyped {3 3} followed by a -multiple tail collected 4 words and occurrencecount then reported the overrun the allocation itself created), and a later REQUIRED ranged argument was starved to a single reserved clause. Three cooperating sites: (a) get_dict_can_assign_value caps a satisfied -multiple argument at its bounded max - it yields the word (no-consume) so the caller's retreat advances to the next argument, serving both the leaders and values loops; the yield carries a G-082 rejection record of new kind 'occurrence', and both loops' overflow selection sites render it as the pointed occurrence-limit report with the G-053 occurrencecount errorcode (count = the attempted occurrence) instead of the generic toomanyarguments - so genuine over-supply keeps its pointed class; (b) reservations are min-occurrence aware - the allocator's tail_needs and the derived valmin floor (leader/value split + option-scan reservation) reserve min-occurrences x min-clause-length for a required ranged argument (e.g a following required -multiple {3 3} reserves 3 clauses; {2 2} pair clauses reserve 4 words); an explicit '@values -min' still overrides the derived floor, and legacy boolean -multiple (no MULTIPLE_RANGES entry) reserves exactly as before; (c) the greedy leader scan caps a bounded -multiple last leader at max occurrences (tracked via leader_posn_names_assigned) so remaining words flow to the opts/values sections. First occurrences are never capped (resolve guarantees range max >= 1); {0 1} at-most-once scalars are unaffected (no collection). define -help -multiple documents the allocation semantics. New multipleranges.test allocation pins: untyped/typed {3 3} cap incl the cap-beats-type-screen 4-ints case, greedy-up-to-max {1 2}, required-range and pair-clause reservations, leaders-side cap + split floor, pointed over-supply report, legacy-greed-unchanged guard. Full punk/args suite 408/0. diff --git a/src/tests/modules/punk/args/testsuites/args/validation.test b/src/tests/modules/punk/args/testsuites/args/validation.test index 418ac77a..3f18d388 100644 --- a/src/tests/modules/punk/args/testsuites/args/validation.test +++ b/src/tests/modules/punk/args/testsuites/args/validation.test @@ -233,6 +233,83 @@ namespace eval ::testspace { {-v {1 1}}\ ] + #slim an errorcode: extras up to (excluding) -argspecs + proc ecextras {opts} { + set ec [dict get $opts -errorcode] + set extras [dict create] + foreach {k v} [lrange $ec 3 end] { + if {$k eq "-argspecs"} {break} + dict set extras $k $v + } + return $extras + } + + #added 2026-08-09 (agent, G-151) - failure-side value truncation follow-on: received + #values embedded in validation error messages are display-bounded via + #private::error_display_value (same report_display_value/TRUNCATE machinery as + #parse_report value cells). Short plain values stay byte-identical (pinned by the + #existing message pins here and in errorselection.test). The expected displays below + #are identical on the full ansistring path and the plain degraded path (pure-ASCII + #values), so the pins are environment-independent. + test errdisplay_long_value_truncated {an over-budget received value is display-truncated in the error message ('...' + raw length) while errorcode -badval carries the raw value}\ + -setup $common -body { + set big [string repeat A 100] + set err [catch {punk::args::parse [list $big] withdef @values {num -type integer -optional 1}} msg opts] + lappend result $err + #built-in budget 48: 35 chars + '...' + ' (len 100)' + lappend result [string match "*Received: '[string repeat A 35]... (len 100)'*" $msg] + #the raw 100-char run appears nowhere in the rendered error + lappend result [expr {[string first [string repeat A 36] $msg] == -1}] + #machine-facing raw value retained + lappend result [expr {[dict get [ecextras $opts] -badval] eq $big}] + }\ + -cleanup { + }\ + -result [list 1 1 1 1] + + #added 2026-08-09 (agent, G-151) + test errdisplay_multiline_value_singlelined {a received value containing newlines renders on one line in the error message}\ + -setup $common -body { + set err [catch {punk::args::parse [list -num "line1\nline2"] withdef @opts {-num -type int} {@values -min 0 -max 0}} msg] + lappend result $err + #both value fragments land on the SAME physical line of the rendered error + set lastline [lindex [split $msg \n] end] + lappend result [expr {[string first line1 $lastline] >= 0 && [string first line2 $lastline] >= 0}] + }\ + -cleanup { + }\ + -result [list 1 1] + + #added 2026-08-09 (agent, G-151) + test errdisplay_reportvaluewidth_caps_error_values {@cmd -reportvaluewidth caps the error-message value display for the definition}\ + -setup $common -body { + set docid ::testspace::errdisplay_reportvaluewidth + punk::args::define [list @id -id $docid] {@cmd -name testspace::errdisplay -reportvaluewidth 20} @opts {-num -type int} {@values -min 0 -max 0} + set big [string repeat A 100] + set err [catch {punk::args::parse [list -num $big] withid $docid} msg] + lappend result $err + #budget 20: 7 chars + '...' + ' (len 100)' + lappend result [string match "*Received: 'AAAAAAA... (len 100)'*" $msg] + }\ + -cleanup { + punk::args::undefine ::testspace::errdisplay_reportvaluewidth 1 + }\ + -result [list 1 1] + + #added 2026-08-09 (agent, G-151) + test errdisplay_unexpected_option_word_truncated {an over-budget unknown flag word is display-truncated in the Unexpected option message while errorcode -badarg carries the raw word}\ + -setup $common -body { + set hugeflag "-[string repeat z 80]" + set err [catch {punk::args::parse [list $hugeflag 1] withdef @opts {-x -type int} {@values -min 0 -max 0}} msg opts] + lappend result $err + #budget 48 with ' (len 81)' marker: 36 chars + '...' + lappend result [string match "*Unexpected option \"-[string repeat z 35]... (len 81)\"*" $msg] + lappend result [expr {[dict get [ecextras $opts] -badarg] eq $hugeflag}] + }\ + -cleanup { + }\ + -result [list 1 1 1] + test opt_default_not_in_received {a defaulted option appears in opts but not in received}\ -setup $common -body { set argd [punk::args::parse {} withdef @opts {-x -type int -default 7} {@values -min 0 -max 0}]