Browse Source
parse -cache overhaul:
- VALIDATION trap's parse_cache write now explicitly gated on -cache (formerly
unconditional but landing in a discarded proc-local for -cache 0 by scoping
accident - 'variable parse_cache' only ran on the -cache 1 branch)
- cached validation errors stored as per {errorstyle callertext} render
variants under a {arglist definition form} main key (-caller dropped from the
main key - results don't depend on it); a missing variant falls through to a
fresh render. Previously the first caller's errorstyle and %caller%
attribution were baked in and replayed verbatim to later callers.
- @dynamic definitions (and legacy leading '-dynamic 1') are never cached so
re-evaluated substitutions always take effect; dev/dynamic-cache.test
known-bug pin flipped
- new punk::args::parse_cache view/clear proc (sgr_cache style); guarded
variable init; -errorstyle definition default corrected to the operative
'standard'. New parsecache.test (7 tests).
synopsis notation + internal @form -synopsis retirement:
- ::punk::args::parse/::parse_status dropped their stale @form -synopsis
overrides (omitted -cache/-caller) for auto-generated lines shaped with
-typesynopsis {<int|formname>...} on -form; drift pin
synopsis_parse_generated added
- punk::ns::synopsis no longer errors on custom @form -synopsis lines that are
not valid Tcl lists (e.g Tcl manpage style '?-form {int|<formname>...}?' -
's parse' raised 'list element in braces followed by ...'): non-list lines
take a textual command-head replacement fallback
- @form -synopsis directive help rewritten (display-only, any style, prefer
auto-generation, known warranted case: script-level/constructed ids);
::punk::args::synopsis -help gains a notation legend and a new @examples
block comparing Tcl man-page ?...? style with the bracket style (punk::args::eg)
eg usability + examples indication:
- punk::args::eg resolves relative/unqualified command names (punk::ns::cmdinfo
from calling context when loaded, else global qualification) - in namespaces
where it shadows the global 'eg' alias (e.g ::punk::args) 'eg list' returned
empty while 'i list' worked; unknown ids now return a message naming the id;
punk::ns::eg hands the typed name through on unresolved docids
- usage-table 'Example: eg <id>' header row now uses scheme colour CLR(check)
(interim display until G-088 footer/subtitle support)
Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
8 changed files with 549 additions and 54 deletions
@ -0,0 +1,188 @@
|
||||
#parsecache.test - behaviour of punk::args::parse -cache 1 and the punk::args::parse_cache |
||||
#inspection utility (punk::args 0.12.5 cache overhaul). |
||||
#Assertions filter cache keys/entries by the test definition's id substring rather than |
||||
#asserting global counts - internal punk::args machinery (e.g. synopsis rendering during |
||||
#error display) may legitimately add its own -cache 1 entries during a test body. |
||||
package require tcltest |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
variable common { |
||||
set result "" |
||||
punk::args::parse_cache -action clear |
||||
} |
||||
|
||||
#return {key value ...} for parse_cache entries whose key contains idglob, |
||||
#optionally restricted to entries of type 'result' or 'error'. |
||||
#NOTE: internal punk::args machinery (e.g. usage-table rendering for standard/enhanced |
||||
#errorstyles) makes its own -cache 1 parses whose keys can contain the definition text |
||||
#of the id under test - filter by entry type to isolate the entries a test created. |
||||
proc pc_entries {idglob {type ""}} { |
||||
set matched {} |
||||
dict for {k v} [punk::args::parse_cache -return dict] { |
||||
if {[string match *${idglob}* $k]} { |
||||
if {$type eq "" || [dict get $v type] eq $type} { |
||||
lappend matched $k $v |
||||
} |
||||
} |
||||
} |
||||
return $matched |
||||
} |
||||
|
||||
test parsecache_result_hit {Ensure -cache 1 stores a result entry and the cached path returns an identical result}\ |
||||
-setup $common -body { |
||||
punk::args::define { |
||||
@id -id ::testspace::pc_res |
||||
@opts -anyopts 0 |
||||
-x -default 0 -type integer |
||||
} |
||||
set r1 [punk::args::parse {-x 5} -cache 1 withid ::testspace::pc_res] |
||||
set r2 [punk::args::parse {-x 5} -cache 1 withid ::testspace::pc_res] |
||||
set entries [pc_entries pc_res result] |
||||
list [expr {$r1 eq $r2}] [llength $entries] [dict get [lindex $entries 1] type] |
||||
}\ |
||||
-cleanup { |
||||
punk::args::undefine ::testspace::pc_res |
||||
punk::args::parse_cache -action clear |
||||
}\ |
||||
-result {1 2 result} |
||||
|
||||
test parsecache_cache0_no_write {Ensure failing parses without -cache add no cache entries (write is gated on -cache)}\ |
||||
-setup $common -body { |
||||
punk::args::define { |
||||
@id -id ::testspace::pc_c0 |
||||
@opts -anyopts 0 |
||||
-x -default 0 -type integer |
||||
} |
||||
catch {punk::args::parse {-x notint1} withid ::testspace::pc_c0} |
||||
catch {punk::args::parse {-x notint2} -errorstyle minimal withid ::testspace::pc_c0} |
||||
#internal rendering machinery may add its own 'result' entries mentioning this |
||||
#definition - our uncached failing parses must not have added 'error' entries, |
||||
#and no entry may be keyed by our failing arglists. |
||||
set leaks 0 |
||||
foreach k [punk::args::parse_cache -return keys] { |
||||
if {[lindex $k 0] in {{-x notint1} {-x notint2}}} { |
||||
incr leaks |
||||
} |
||||
} |
||||
list [llength [pc_entries pc_c0 error]] $leaks |
||||
}\ |
||||
-cleanup { |
||||
punk::args::undefine ::testspace::pc_c0 |
||||
punk::args::parse_cache -action clear |
||||
}\ |
||||
-result {0 0} |
||||
|
||||
test parsecache_error_variant_replay {Ensure an identical repeated failing -cache 1 call replays its cached render (single variant, identical message)}\ |
||||
-setup $common -body { |
||||
punk::args::define { |
||||
@id -id ::testspace::pc_replay |
||||
@opts -anyopts 0 |
||||
-x -default 0 -type integer |
||||
} |
||||
catch {punk::args::parse {-x notint} -cache 1 -errorstyle minimal withid ::testspace::pc_replay} m1 |
||||
catch {punk::args::parse {-x notint} -cache 1 -errorstyle minimal withid ::testspace::pc_replay} m2 |
||||
set entries [pc_entries pc_replay error] |
||||
set entry [lindex $entries 1] |
||||
list [expr {$m1 eq $m2}] [llength $entries] [dict get $entry type] [dict size [dict get $entry value]] |
||||
}\ |
||||
-cleanup { |
||||
punk::args::undefine ::testspace::pc_replay |
||||
punk::args::parse_cache -action clear |
||||
}\ |
||||
-result {1 2 error 1} |
||||
|
||||
test parsecache_errorstyle_variants {Ensure a cached error render is not replayed to a call wanting a different -errorstyle}\ |
||||
-setup $common -body { |
||||
punk::args::define { |
||||
@id -id ::testspace::pc_style |
||||
@opts -anyopts 0 |
||||
-x -default 0 -type integer |
||||
} |
||||
catch {punk::args::parse {-x notint} -cache 1 -errorstyle minimal -caller CST withid ::testspace::pc_style} m_min |
||||
catch {punk::args::parse {-x notint} -cache 1 -errorstyle standard -caller CST withid ::testspace::pc_style} m_std |
||||
set entry [lindex [pc_entries pc_style error] 1] |
||||
list [expr {[string length $m_std] > [string length $m_min]}] [dict size [dict get $entry value]] |
||||
}\ |
||||
-cleanup { |
||||
punk::args::undefine ::testspace::pc_style |
||||
punk::args::parse_cache -action clear |
||||
}\ |
||||
-result {1 2} |
||||
|
||||
test parsecache_caller_variants {Ensure cached error attribution follows each call's -caller rather than replaying the first caller's render}\ |
||||
-setup $common -body { |
||||
punk::args::define { |
||||
@id -id ::testspace::pc_caller |
||||
@opts -anyopts 0 |
||||
-x -default 0 -type integer |
||||
} |
||||
catch {punk::args::parse {-x notint} -cache 1 -errorstyle minimal -caller ONECMD withid ::testspace::pc_caller} m1 |
||||
catch {punk::args::parse {-x notint} -cache 1 -errorstyle minimal -caller TWOCMD withid ::testspace::pc_caller} m2 |
||||
set entry [lindex [pc_entries pc_caller error] 1] |
||||
list [string match *ONECMD* $m1] [string match *TWOCMD* $m2] [string match *ONECMD* $m2] [dict size [dict get $entry value]] |
||||
}\ |
||||
-cleanup { |
||||
punk::args::undefine ::testspace::pc_caller |
||||
punk::args::parse_cache -action clear |
||||
}\ |
||||
-result {1 1 0 2} |
||||
|
||||
test parsecache_dynamic_bypass {Ensure @dynamic definitions are never cached by parse -cache 1}\ |
||||
-setup $common -body { |
||||
variable pc_dyn_list {A B C} |
||||
proc ::testspace::pc_dyn_get {} { |
||||
variable pc_dyn_list |
||||
return $pc_dyn_list |
||||
} |
||||
namespace eval dynwhatever { |
||||
set DYN_LIST {${[::testspace::pc_dyn_get]}} |
||||
punk::args::define { |
||||
@dynamic |
||||
@id -id ::testspace::pc_dyn |
||||
@values |
||||
param -type list -default "${$DYN_LIST}" |
||||
} |
||||
} |
||||
set argd [punk::args::parse {} -cache 1 withid ::testspace::pc_dyn] |
||||
lappend result [dict get $argd values param] |
||||
set ::testspace::pc_dyn_list {X Y Z} |
||||
set argd [punk::args::parse {} -cache 1 withid ::testspace::pc_dyn] |
||||
lappend result [dict get $argd values param] |
||||
list $result [llength [pc_entries pc_dyn]] |
||||
}\ |
||||
-cleanup { |
||||
namespace delete ::testspace::dynwhatever |
||||
rename ::testspace::pc_dyn_get {} |
||||
punk::args::undefine ::testspace::pc_dyn |
||||
punk::args::parse_cache -action clear |
||||
}\ |
||||
-result [list [list {A B C} {X Y Z}] 0] |
||||
|
||||
test parsecache_utility {Ensure parse_cache summary/keys/dict/clear views behave}\ |
||||
-setup $common -body { |
||||
punk::args::define { |
||||
@id -id ::testspace::pc_util |
||||
@opts -anyopts 0 |
||||
-x -default 0 -type integer |
||||
} |
||||
punk::args::parse {-x 1} -cache 1 withid ::testspace::pc_util |
||||
catch {punk::args::parse {-x notint} -cache 1 -errorstyle minimal -caller CST withid ::testspace::pc_util} |
||||
set s [punk::args::parse_cache] |
||||
lappend result [expr {[dict get $s entries] >= 2}] |
||||
lappend result [expr {[dict get $s results] >= 1}] |
||||
lappend result [expr {[dict get $s errors] >= 1}] |
||||
lappend result [expr {[dict get $s error_variants] >= 1}] |
||||
lappend result [expr {[dict get $s chars] > 0}] |
||||
lappend result [expr {[llength [punk::args::parse_cache -return keys]] == [dict get $s entries]}] |
||||
lappend result [punk::args::parse_cache -action clear] |
||||
set s2 [punk::args::parse_cache] |
||||
lappend result [dict get $s2 entries] |
||||
}\ |
||||
-cleanup { |
||||
punk::args::undefine ::testspace::pc_util |
||||
punk::args::parse_cache -action clear |
||||
}\ |
||||
-result {1 1 1 1 1 1 {parse_cache cleared} 0} |
||||
} |
||||
tcltest::cleanupTests ;#needed to produce test summary line. |
||||
Loading…
Reference in new issue