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] |
||||
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 |
||||
#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