Browse Source
- the ::tcl::string::is definition harvests its class set at define time from the bad-class error message of a deliberately invalid probe (safe, side-effect-free) - accept/reject parity with the loading interpreter by construction: 8.6.13 = 21 classes (no dict - the previous static 9.0 list wrongly ACCEPTED string is dict there), 8.7a6 = 23 (+dict +unicode), 9.0.3 = 22 (unicode removed). Fallback to the 9.0 set if the message format ever changes - hand-written man-page descriptions (kept verbatim, tstr-processed as before so the A_WARN highlights are unchanged) apply only to classes the runtime accepts; accepted-but-undescribed future classes get a generic label; static version notes added to dict (not in 8.6) and the new unicode entry (unreleased 8.7 only - removed in tcl 9). The per-class virtual docids (::tcl::string::is <class>) follow the harvested set automatically - new tclcoreparity.test (4 tests, gated on have_tclcoredocs): choices equal the live-harvested set and every documented choice is really accepted; per-class docids exist for every class; error-vs-ok outcome agrees between real string is and parse_status across the 23-shape probe matrix (missing args, trailing flag-like str, option/class prefixes + ambiguity, unknown option/class, -failindex var consumption, per-version dict/unicode presence, divergent-classification shapes); version-note labels conditional on presence. Expectations derived from the LIVE interpreter, never version arithmetic - green on 9.0.3, 8.7a6 and (via a direct tcltest driver, since runtests infrastructure does not run under the plain 8.6 kit) 8.6.13 - full punk/args + punk/ns trees green (219 pass + 1 pre-existing skip) incl the have_tclcoredocs cmdhelp pins Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
7 changed files with 222 additions and 41 deletions
@ -1,3 +1,3 @@ |
|||||||
[project] |
[project] |
||||||
name = "punkshell" |
name = "punkshell" |
||||||
version = "0.8.1" |
version = "0.8.2" |
||||||
|
|||||||
@ -1,3 +1,4 @@ |
|||||||
0.1.0 |
0.2.0 |
||||||
#First line must be a semantic version number |
#First line must be a semantic version number |
||||||
#all other lines are ignored. |
#all other lines are ignored. |
||||||
|
#0.2.0 - G-054: 'string is' class choices (and the generated per-class virtual docids) are harvested from the RUNNING interpreter at define time instead of a hand-maintained list - a deliberately invalid probe of the builtin yields the authoritative class set from its error message (8.6: 21 classes, no dict; unreleased 8.7: +dict +unicode; 9.0: +dict, unicode removed), fixing accept/reject drift such as the doc wrongly accepting 'string is dict' under 8.6. Hand-written man-page descriptions apply only to classes the runtime accepts (generic label for unrecognized future classes); static version notes on dict (not in 8.6) and unicode (unreleased 8.7 only). Parity pinned by tclcoreparity.test with expectations derived from the live interpreter (green on 8.6.13, 8.7a6, 9.0.3) |
||||||
|
|||||||
@ -0,0 +1,151 @@ |
|||||||
|
package require tcltest |
||||||
|
|
||||||
|
package require punk::args |
||||||
|
|
||||||
|
#G-054: behavioural parity between the punk::args::moduledoc::tclcore model of |
||||||
|
#'string is' and the RUNNING interpreter. The class choices are harvested from the |
||||||
|
#runtime at define time (8.6 has no dict class; the unreleased 8.7 series added |
||||||
|
#unicode, which tcl 9 removed), so these tests derive their expectations from the |
||||||
|
#LIVE interpreter - never from version arithmetic - and pass unchanged on 8.6, 8.7 |
||||||
|
#and 9.x. |
||||||
|
# |
||||||
|
#Parity is asserted on the error-vs-ok OUTCOME of a call shape (real 'string is' |
||||||
|
#raising vs punk::args::parse_status ok field) - not on message wording (punkshell |
||||||
|
#deliberately uses its own synopsis/message style) and not on failure classification |
||||||
|
#(e.g 'string is digit 1 2' is real "bad option" vs model "too many arguments" - |
||||||
|
#both errors, divergent blame is accepted; see goals/G-055 fidelity policy). |
||||||
|
|
||||||
|
namespace eval ::testspace { |
||||||
|
namespace import ::tcltest::* |
||||||
|
variable common { |
||||||
|
set result "" |
||||||
|
} |
||||||
|
|
||||||
|
testConstraint have_tclcoredocs [expr {![catch {package require punk::args::moduledoc::tclcore}]}] |
||||||
|
|
||||||
|
#harvest the runtime's class list the same way the moduledoc does - from the |
||||||
|
#bad-class error message of a deliberately invalid probe |
||||||
|
proc live_classes {} { |
||||||
|
set classes [list] |
||||||
|
if {[catch {string is __punk_parity_probe__ x} msg]} { |
||||||
|
if {[regexp {must be (.+)$} $msg -> csv]} { |
||||||
|
foreach c [split $csv ,] { |
||||||
|
set c [string trim $c] |
||||||
|
if {[string match "or *" $c]} { |
||||||
|
set c [string range $c 3 end] |
||||||
|
} |
||||||
|
if {$c ne ""} {lappend classes $c} |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
return [lsort $classes] |
||||||
|
} |
||||||
|
#1 if the real 'string is' call shape is accepted (returns 0/1), 0 if it raises |
||||||
|
proc real_ok {tail} { |
||||||
|
return [expr {![catch {string is {*}$tail} __ignored]}] |
||||||
|
} |
||||||
|
#1 if the doc model accepts the same tail, 0 if it reports a validation failure |
||||||
|
proc doc_ok {tail} { |
||||||
|
return [dict get [punk::args::parse_status $tail withid ::tcl::string::is] ok] |
||||||
|
} |
||||||
|
|
||||||
|
test tclcoreparity_stringis_choices_match_runtime {the documented class choices equal the set the running interpreter accepts}\ |
||||||
|
-constraints have_tclcoredocs\ |
||||||
|
-setup $common -body { |
||||||
|
set doc_choices [lsort [dict get [lrange [punk::args::resolved_def -types leaders ::tcl::string::is class] 1 end] -choices]] |
||||||
|
lappend result [expr {$doc_choices eq [live_classes]}] |
||||||
|
#and every documented choice really is accepted by the interpreter |
||||||
|
set rejected [list] |
||||||
|
foreach c $doc_choices { |
||||||
|
if {![real_ok [list $c 1]]} {lappend rejected $c} |
||||||
|
} |
||||||
|
lappend result $rejected |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list 1 {}] |
||||||
|
|
||||||
|
test tclcoreparity_stringis_perclass_ids {a per-class virtual docid exists for every harvested class}\ |
||||||
|
-constraints have_tclcoredocs\ |
||||||
|
-setup $common -body { |
||||||
|
set missing [list] |
||||||
|
foreach c [live_classes] { |
||||||
|
if {![punk::args::id_exists "::tcl::string::is $c"]} {lappend missing $c} |
||||||
|
} |
||||||
|
lappend result $missing |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list {}] |
||||||
|
|
||||||
|
test tclcoreparity_stringis_probe_matrix {error-vs-ok outcome agrees between the real interpreter and the doc model across the probe matrix}\ |
||||||
|
-constraints have_tclcoredocs\ |
||||||
|
-setup $common -body { |
||||||
|
#matrix per G-054 acceptance: missing args, trailing flag-like str word, |
||||||
|
#option/class unique-prefix acceptance and ambiguity rejection, unknown |
||||||
|
#option/class, -failindex var consumption leaving no str, per-version class |
||||||
|
#presence (dict, unicode), plus middle-word and option-order shapes whose |
||||||
|
#CLASSIFICATION diverges but whose outcome must still agree |
||||||
|
set matrix [list {*}{ |
||||||
|
{} |
||||||
|
{digit} |
||||||
|
{digit 123} |
||||||
|
{digit 12x} |
||||||
|
{digit -strict} |
||||||
|
{digit -strict -strict} |
||||||
|
{digit -failindex} |
||||||
|
{digit -failindex pmvar} |
||||||
|
{digit -failindex pmvar 12x} |
||||||
|
{digit -s 123} |
||||||
|
{digit -f pmvar 12x} |
||||||
|
{digit -gorp 123} |
||||||
|
{tr 1} |
||||||
|
{do 123} |
||||||
|
{d 123} |
||||||
|
{gorp 123} |
||||||
|
{digit 1 2} |
||||||
|
{-strict digit 1} |
||||||
|
{digit -strict -failindex pmvar 123} |
||||||
|
{dict x} |
||||||
|
{unicode x} |
||||||
|
{entier 5} |
||||||
|
{boolean -failindex pmvar xyz} |
||||||
|
}] |
||||||
|
set mismatches [list] |
||||||
|
foreach tail $matrix { |
||||||
|
set r [real_ok $tail] |
||||||
|
set d [doc_ok $tail] |
||||||
|
if {$r != $d} { |
||||||
|
lappend mismatches [list $tail real $r doc $d] |
||||||
|
} |
||||||
|
} |
||||||
|
lappend result $mismatches |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
catch {unset pmvar} |
||||||
|
}\ |
||||||
|
-result [list {}] |
||||||
|
|
||||||
|
test tclcoreparity_stringis_version_notes {version-difference labels appear exactly when the class is present in this runtime}\ |
||||||
|
-constraints have_tclcoredocs\ |
||||||
|
-setup $common -body { |
||||||
|
set labels [dict get [lrange [punk::args::resolved_def -types leaders ::tcl::string::is class] 1 end] -choicelabels] |
||||||
|
set classes [live_classes] |
||||||
|
if {"dict" in $classes} { |
||||||
|
lappend result [string match "*not present in*8.6*" [dict get $labels dict]] |
||||||
|
} else { |
||||||
|
lappend result [dict exists $labels dict] |
||||||
|
} |
||||||
|
if {"unicode" in $classes} { |
||||||
|
lappend result [string match "*unreleased Tcl 8.7*" [dict get $labels unicode]] |
||||||
|
} else { |
||||||
|
lappend result [dict exists $labels unicode] |
||||||
|
} |
||||||
|
#a class always present keeps its man-page description |
||||||
|
lappend result [string match "*Unicode digit*" [dict get $labels digit]] |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list [expr {"dict" in [live_classes]}] [expr {"unicode" in [live_classes]}] 1] |
||||||
|
} |
||||||
|
tcltest::cleanupTests ;#needed to produce test summary line. |
||||||
Loading…
Reference in new issue