Browse Source
suite_tcl90 now assembles and verifies the G-103 family as part of the default pipeline: - kit-family: two staging trees (core, bi) wrap into working-name products tclsh9.0.5.exe / tclsh9.0.5-punk.exe / tclsh9.0.5-punk-bi.exe under out/family. Attached image mirrors the installed prefix - tcl_library/ at the app root (stock C-boot position, no main.tcl - falls through to the interactive shell), tm tree at tcl9/<ver>, batteries under lib/ with their installed-shape pkgIndexes (../../bin -> /app/bin), dlls under bin/, plus a one-line stock pkgIndex hook at lib/pkgIndex.tcl extending auto_path (the tclPkgUnknown mid-scan growth mechanism tcllib's own index uses). - tools/family_check.tcl: per-member self-containment verification from a scratch dir with scrubbed env - patchlevel, zipfs tcl_library, tzdata/ encodings, attached tm modules, functional Thread (cross-thread eval), vfs zip-mount round-trip, tcllib md5 + tcllibc accel engaged, piperepl default-ON/opt-out per variant (::tclsh(istty) discriminator), Tk create/destroy + tklib for bi. All three members PASS. - kit-family-artifacts + tools/family_artifacts.tcl: punkbin-layout emission (immutable -r<N> names via -Dfamilyrev, per-artifact toml metadata with variant/sha1/versions/provenance/G-107 evidence, sha1sums.txt), run UNDER the plain family kit itself. punkbin publication stays a user step. - build_tclthread/build_tk return pkgidx+version facts; tclvfs configured package generation shared between prefix install and family staging; tm-module install list single-sourced; manifestUuid helper tolerates repos without the fossil manifest setting. - consumers: mapvfs.config entries punk9_beta (punk + punk9wintk905.vfs) and punk9bi_beta (punk-bi + punk9win_for_tkruntime.vfs); working names copied to bin/runtime/win32-x86_64 (untracked). src/runtime/AGENTS.md stale runtime.cmd references updated to punk-runtime (G-097). Full pipeline suite.tcl build PASS end-to-end; verification evidence recorded in the goal Progress section. Remaining: punk-runtime list/use metadata surfacing, kit-wrap trial of the new mapvfs entries. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
12 changed files with 770 additions and 52 deletions
@ -0,0 +1,145 @@
|
||||
#family_artifacts.tcl (G-103): emit punkbin-layout artifact copies + per-artifact |
||||
#toml metadata + sha1sums for the verified runtime kit family members. |
||||
# |
||||
#Deliberately run UNDER THE PLAIN FAMILY KIT itself (not the builder shell): the |
||||
#sha1 digests come from the kit's attached tcllib/tcllibc, so every emission run |
||||
#doubles as a proof that the family runtime executes real tooling self-contained. |
||||
# |
||||
#Artifact tier naming (G-103 naming decision): <workingname minus .exe>-r<N>.exe - |
||||
#immutable punkbin names; the -r<N> assembly revision comes from the invocation |
||||
#(-rev, suite option -Dfamilyrev). The emitted tree mirrors a punkbin platform |
||||
#folder: <outdir>/<artifact>.exe + <artifact>.toml + sha1sums.txt (punkbin |
||||
#format: '<sha1> *<filename>'). Publication to the real punkbin repo is a |
||||
#deliberate user step (copy + build_sha1sums.tcl there); it is DEFERRED per the |
||||
#goal notes until the family shape is accepted. |
||||
# |
||||
#args: -outdir <dir> -rev <N> -target <punkbin platform, e.g win32-x86_64> |
||||
# -suite <name> -tclpatch <patchlevel> -zig <version> -optimize <mode> |
||||
# -components {<name> <ver> ...} (attached battery versions, all variants) |
||||
# -bicomponents {<name> <ver> ...} (additional bi-only batteries) |
||||
# -provenance {<name> <uuid> ...} (source checkout uuids) |
||||
# -testreports <dir> (G-107 evidence summaries; optional) |
||||
# -kits {<variant> <workingexepath> ...} |
||||
|
||||
proc fail {msg} {puts stderr "family_artifacts FAIL: $msg"; flush stderr; exit 1} |
||||
proc note {msg} {puts stdout "family_artifacts: $msg"; flush stdout} |
||||
|
||||
array set opt { |
||||
-outdir {} -rev 1 -target {} -suite {} -tclpatch {} -zig {} -optimize {} |
||||
-components {} -bicomponents {} -provenance {} -testreports {} -kits {} |
||||
} |
||||
foreach {k v} $argv { |
||||
if {![info exists opt($k)]} {fail "unknown option '$k'"} |
||||
set opt($k) $v |
||||
} |
||||
foreach req {-outdir -target -suite -tclpatch -zig -optimize -components -kits} { |
||||
if {$opt($req) eq ""} {fail "missing required option $req"} |
||||
} |
||||
if {![string is integer -strict $opt(-rev)] || $opt(-rev) < 1} {fail "-rev must be a positive integer"} |
||||
|
||||
if {[catch {package require sha1} sha1ver]} { |
||||
fail "package require sha1 failed under [info nameofexecutable] - the family kit must carry tcllib: $sha1ver" |
||||
} |
||||
|
||||
proc toml_str {s} { |
||||
#basic toml string: escape backslash and double-quote (values here are names, |
||||
#versions, uuids, iso dates - no control chars expected) |
||||
return "\"[string map {\\ \\\\ \" \\\"} $s]\"" |
||||
} |
||||
|
||||
file mkdir $opt(-outdir) |
||||
set built [clock format [clock seconds] -format %Y-%m-%dT%H:%M:%SZ -timezone :UTC] |
||||
set sha1lines {} |
||||
set emitted {} |
||||
|
||||
foreach {variant kitpath} $opt(-kits) { |
||||
set kitpath [file normalize $kitpath] |
||||
if {![file exists $kitpath]} {fail "kit exe not found: $kitpath"} |
||||
set working [file tail $kitpath] |
||||
set artifact "[file rootname $working]-r$opt(-rev)[file extension $working]" |
||||
set dest [file join $opt(-outdir) $artifact] |
||||
file delete -force $dest |
||||
file copy $kitpath $dest |
||||
set sha1 [sha1::sha1 -hex -file $dest] |
||||
set size [file size $dest] |
||||
lappend sha1lines "$sha1 *$artifact" |
||||
|
||||
set components $opt(-components) |
||||
if {$variant eq "punk-bi"} {lappend components {*}$opt(-bicomponents)} |
||||
set batteries {} |
||||
foreach {n v} $components {lappend batteries [toml_str "$n $v"]} |
||||
|
||||
set m {} |
||||
lappend m "#punkshell runtime artifact metadata (G-103) - generated by family_artifacts.tcl" |
||||
lappend m "\[artifact\]" |
||||
lappend m "name = [toml_str $artifact]" |
||||
lappend m "class = \"runtime\"" |
||||
lappend m "variant = [toml_str $variant]" |
||||
lappend m "working_name = [toml_str $working]" |
||||
lappend m "revision = $opt(-rev)" |
||||
lappend m "target = [toml_str $opt(-target)]" |
||||
lappend m "sha1 = [toml_str $sha1]" |
||||
lappend m "size = $size" |
||||
lappend m "built = [toml_str $built]" |
||||
lappend m "" |
||||
lappend m "\[runtime\]" |
||||
lappend m "tcl_patchlevel = [toml_str $opt(-tclpatch)]" |
||||
set pr [expr {$variant ne "plain"}] |
||||
lappend m "piperepl = [expr {$pr ? "true" : "false"}]" |
||||
if {$pr} { |
||||
lappend m "piperepl_default = \"on\"" |
||||
lappend m "piperepl_opt_out = \"TCLSH_PIPEREPL=0\"" |
||||
} |
||||
lappend m "attached_batteries = \[[join $batteries {, }]\]" |
||||
lappend m "" |
||||
lappend m "\[provenance\]" |
||||
lappend m "suite = [toml_str $opt(-suite)]" |
||||
lappend m "toolchain = [toml_str "zig $opt(-zig)"]" |
||||
lappend m "optimize = [toml_str $opt(-optimize)]" |
||||
foreach {n uuid} $opt(-provenance) { |
||||
lappend m "${n}_checkout = [toml_str $uuid]" |
||||
} |
||||
#G-107 evidence summaries available at emission time (result lines only; the |
||||
#full line-record summaries stay the canonical evidence artifacts) |
||||
if {$opt(-testreports) ne "" && [file isdirectory $opt(-testreports)]} { |
||||
set tlines {} |
||||
foreach sf [lsort [glob -nocomplain -directory $opt(-testreports) *.summary]] { |
||||
set rec [dict create] |
||||
set f [open $sf r] |
||||
foreach line [split [read $f] \n] { |
||||
set line [string trim $line] |
||||
if {$line eq "" || [string index $line 0] eq "#"} continue |
||||
if {[catch {llength $line} n] || $n < 2} continue |
||||
dict set rec [lindex $line 0] [lrange $line 1 end] |
||||
} |
||||
close $f |
||||
if {![dict exists $rec library] || ![dict exists $rec result]} continue |
||||
set lib [dict get $rec library] |
||||
set parts [list "result=[dict get $rec result]"] |
||||
foreach fkey {mode total passed skipped failed} { |
||||
if {[dict exists $rec $fkey]} {lappend parts "$fkey=[dict get $rec $fkey]"} |
||||
} |
||||
lappend tlines "$lib = [toml_str [join $parts { }]]" |
||||
} |
||||
if {[llength $tlines]} { |
||||
lappend m "" |
||||
lappend m "\[tests\]" |
||||
lappend m {*}$tlines |
||||
} |
||||
} |
||||
set mf [file join $opt(-outdir) "[file rootname $artifact].toml"] |
||||
set f [open $mf w] |
||||
fconfigure $f -translation lf |
||||
puts $f [join $m \n] |
||||
close $f |
||||
lappend emitted "$variant -> $artifact" |
||||
note "emitted $artifact (sha1 $sha1, [expr {$size/1024}] KB) + [file tail $mf]" |
||||
} |
||||
|
||||
set f [open [file join $opt(-outdir) sha1sums.txt] w] |
||||
fconfigure $f -translation lf |
||||
puts $f [join $sha1lines \n] |
||||
close $f |
||||
note "sha1sums.txt written ([llength $sha1lines] artifacts)" |
||||
puts "family_artifacts OK: [join $emitted {; }] -> $opt(-outdir)" |
||||
exit 0 |
||||
@ -0,0 +1,201 @@
|
||||
#family_check.tcl (G-103): self-containment verification for one runtime kit |
||||
#family member (plain / punk / punk-bi). Run under the suite-built BUILDER shell; |
||||
#the KIT exe under test is exec'd as probe children. |
||||
# |
||||
#Why the copy-to-scratch: beside the installed out/family location sits ../lib |
||||
#(the suite prefix), which the stock tm-path setup (<exedir>/../lib) and |
||||
#tcl_findLibrary's exe-relative entries would silently satisfy. The kit is copied |
||||
#alone into a fresh scratch dir and probed FROM THERE with cwd=scratch, so only |
||||
#the attached image can serve the probes ("no external Tcl visible"). |
||||
# |
||||
#The probe environment is scrubbed of every tcl redirection var (TCL_LIBRARY, |
||||
#TK_LIBRARY, TCLLIBPATH, VFS_LIBRARY, TCL*_TM_PATH); TCLSH_PIPEREPL is controlled |
||||
#per probe - it is the punk-vs-plain discriminator (G-096 behaviour matrix: with |
||||
#the gate open the patched shell publishes ::tclsh(istty) before the startup |
||||
#script runs; with TCLSH_PIPEREPL=0 or unpatched sources no ::tclsh machinery |
||||
#exists). Script-arg probes never set ::tclsh(dorepl), so no probe can land in |
||||
#the console-reopen repl (no hang risk). |
||||
# |
||||
#args: -exe <kitexe> -variant plain|punk|punk-bi -expectpatch <patchlevel> |
||||
# -thread <ver> -vfs <ver> -tcllib <ver> ?-tk <patchlevel>? ?-tklib <ver>? |
||||
|
||||
proc fail {msg} {puts stderr "family_check FAIL: $msg"; flush stderr; exit 1} |
||||
proc note {msg} {puts stdout "family_check: $msg"; flush stdout} |
||||
|
||||
array set opt {-exe {} -variant {} -expectpatch {} -thread {} -vfs {} -tcllib {} -tk {} -tklib {}} |
||||
foreach {k v} $argv { |
||||
if {![info exists opt($k)]} {fail "unknown option '$k'"} |
||||
set opt($k) $v |
||||
} |
||||
foreach req {-exe -variant -expectpatch -thread -vfs -tcllib} { |
||||
if {$opt($req) eq ""} {fail "missing required option $req"} |
||||
} |
||||
if {$opt(-variant) ni {plain punk punk-bi}} {fail "-variant must be plain|punk|punk-bi"} |
||||
if {$opt(-variant) eq "punk-bi" && ($opt(-tk) eq "" || $opt(-tklib) eq "")} { |
||||
fail "punk-bi variant requires -tk and -tklib expected versions" |
||||
} |
||||
set exe [file normalize $opt(-exe)] |
||||
if {![file exists $exe]} {fail "kit exe not found: $exe"} |
||||
|
||||
#-- scrub the probe environment (children inherit ::env at exec time) --------- |
||||
foreach ev [array names ::env] { |
||||
if {$ev in {TCL_LIBRARY TK_LIBRARY TCLLIBPATH VFS_LIBRARY TCLSH_PIPEREPL} |
||||
|| [string match TCL*_TM_PATH $ev]} { |
||||
unset ::env($ev) |
||||
} |
||||
} |
||||
|
||||
#-- scratch dir with the kit copied in alone --------------------------------- |
||||
set scratch [file join [file tempdir] "punkfamilycheck_[pid]_[clock clicks -microseconds]"] |
||||
file mkdir $scratch |
||||
set kitname [file tail $exe] |
||||
set kit [file join $scratch $kitname] |
||||
file copy $exe $kit |
||||
|
||||
proc probe {name script args} { |
||||
#write the probe script into the scratch dir and run the kit on it with |
||||
#cwd=scratch; env pairs in $args are set for the child and removed after. |
||||
#returns the child output; fails hard on nonzero exit. |
||||
global scratch kit |
||||
set sf [file join $scratch probe_$name.tcl] |
||||
set f [open $sf w] |
||||
puts $f $script |
||||
close $f |
||||
foreach {ev val} $args {set ::env($ev) $val} |
||||
set rc [catch {exec $kit $sf 2>@1} out] |
||||
foreach {ev val} $args {unset ::env($ev)} |
||||
if {$rc} {fail "probe '$name' failed (kit $kit):\n$out"} |
||||
return $out |
||||
} |
||||
proc checks {output} { |
||||
#parse 'CHECK <key> <value>' lines into a dict |
||||
set d [dict create] |
||||
foreach line [split $output \n] { |
||||
set line [string trim $line] |
||||
if {[string match "CHECK *" $line]} { |
||||
dict set d [lindex $line 1] [lindex $line 2] |
||||
} |
||||
} |
||||
return $d |
||||
} |
||||
proc asserteq {d key expect what} { |
||||
if {![dict exists $d $key]} {fail "$what: no CHECK line for '$key' (got: $d)"} |
||||
set got [dict get $d $key] |
||||
if {$got ne $expect} {fail "$what: $key = '$got', expected '$expect'"} |
||||
} |
||||
|
||||
#-- probe: core batteries (all variants) ------------------------------------- |
||||
#Also proves cwd independence: the probe chdirs into a subdir it creates, so |
||||
#relative-path leakage from the scratch dir itself would surface. |
||||
set core_script { |
||||
proc out {k v} {puts [list CHECK $k $v]} |
||||
out patchlevel [info patchlevel] |
||||
out tcl_library $::tcl_library |
||||
out library_zipfs [string match //zipfs:/app/* $::tcl_library] |
||||
#attached-library facts (suite_smoke parity) |
||||
out tz [expr {[catch {clock format 0 -gmt 0 -format %Z}] ? "FAIL" : "ok"}] |
||||
out encoding [expr {[catch {encoding convertto cp1250 test}] ? "FAIL" : "ok"}] |
||||
#tm path serves modules from the attached image (tcl9/<ver> beside tcl_library) |
||||
out platform_tm [expr {[catch {package require platform} v] ? "FAIL:$v" : "ok"}] |
||||
#Thread: version + functional cross-thread eval |
||||
if {[catch {package require Thread} tver]} {out thread "FAIL:$tver"} else { |
||||
out thread $tver |
||||
set tid [thread::create] |
||||
out thread_eval [thread::send $tid {expr {6*7}}] |
||||
thread::release $tid |
||||
} |
||||
#tclvfs: version + representative vfs::* + functional zip mount round-trip |
||||
#(the kit's own zipfs mkzip makes the test archive - no external tools) |
||||
if {[catch {package require vfs} vver]} {out vfs "FAIL:$vver"} else { |
||||
out vfs $vver |
||||
out vfs_zip [expr {[catch {package require vfs::zip} zv] ? "FAIL:$zv" : $zv}] |
||||
out vfs_urltype [expr {[catch {package require vfs::urltype} uv] ? "FAIL:$uv" : $uv}] |
||||
set d [file join [pwd] vfstest] |
||||
file mkdir $d/payload |
||||
set f [open $d/payload/hello.txt w]; puts -nonewline $f "family-vfs-roundtrip"; close $f |
||||
cd $d |
||||
tcl::zipfs::mkzip probe.zip payload payload |
||||
set mnt [vfs::zip::Mount [file join $d probe.zip] zipmnt] |
||||
set f [open zipmnt/hello.txt r]; set data [read $f]; close $f |
||||
vfs::zip::Unmount $mnt zipmnt |
||||
out vfs_roundtrip [expr {$data eq "family-vfs-roundtrip" ? "ok" : "FAIL:$data"}] |
||||
} |
||||
#tcllib module + tcllibc acceleration engaged (pkg_smoke -accel parity) |
||||
if {[catch {package require md5} mver]} {out md5 "FAIL:$mver"} else { |
||||
out md5 $mver |
||||
out tcllibc [expr {[catch {package require tcllibc} cv] ? "FAIL:$cv" : $cv}] |
||||
upvar #0 ::md5::accel accelarr |
||||
out md5_accel [expr {[info exists accelarr(critcl)] && $accelarr(critcl) ? 1 : 0}] |
||||
} |
||||
exit 0 |
||||
} |
||||
set d [checks [probe core $core_script]] |
||||
asserteq $d patchlevel $opt(-expectpatch) "core" |
||||
asserteq $d library_zipfs 1 "core (tcl_library=[dict get $d tcl_library])" |
||||
asserteq $d tz ok "core" |
||||
asserteq $d encoding ok "core" |
||||
asserteq $d platform_tm ok "core" |
||||
asserteq $d thread $opt(-thread) "core" |
||||
asserteq $d thread_eval 42 "core" |
||||
asserteq $d vfs $opt(-vfs) "core" |
||||
asserteq $d vfs_roundtrip ok "core" |
||||
asserteq $d md5_accel 1 "core (tcllibc=[expr {[dict exists $d tcllibc]?[dict get $d tcllibc]:"?"}])" |
||||
foreach k {vfs_zip vfs_urltype tcllibc} { |
||||
if {[string match FAIL* [dict get $d $k]]} {fail "core: $k [dict get $d $k]"} |
||||
} |
||||
note "core OK ($opt(-variant)): tcl [dict get $d patchlevel] library [dict get $d tcl_library] thread [dict get $d thread] vfs [dict get $d vfs] (zip [dict get $d vfs_zip], urltype [dict get $d vfs_urltype]) md5 [dict get $d md5] accel=1" |
||||
|
||||
#-- probe: Tk create/destroy (bi only) --------------------------------------- |
||||
if {$opt(-variant) eq "punk-bi"} { |
||||
set tk_script { |
||||
proc out {k v} {puts [list CHECK $k $v]} |
||||
if {[catch {package require Tk} tkver]} {out tk "FAIL:$tkver"; exit 0} |
||||
out tk $tkver |
||||
wm withdraw . |
||||
button .b -text family |
||||
out tk_widget [winfo exists .b] |
||||
destroy .b |
||||
out tk_widget_destroyed [expr {![winfo exists .b]}] |
||||
destroy . |
||||
out tk_done ok |
||||
exit 0 |
||||
} |
||||
set d [checks [probe tk $tk_script]] |
||||
asserteq $d tk $opt(-tk) "tk" |
||||
asserteq $d tk_widget 1 "tk" |
||||
asserteq $d tk_widget_destroyed 1 "tk" |
||||
asserteq $d tk_done ok "tk" |
||||
#tklib rides only in the bi payload |
||||
set tklib_script { |
||||
proc out {k v} {puts [list CHECK $k $v]} |
||||
package require Tk |
||||
wm withdraw . |
||||
out tooltip [expr {[catch {package require tooltip} v] ? "FAIL:$v" : $v}] |
||||
destroy . |
||||
exit 0 |
||||
} |
||||
set d [checks [probe tklib $tklib_script]] |
||||
if {[string match FAIL* [dict get $d tooltip]]} {fail "tklib: tooltip [dict get $d tooltip]"} |
||||
note "tk OK: Tk $opt(-tk) create/destroy + tklib tooltip [dict get $d tooltip]" |
||||
} |
||||
|
||||
#-- probe: piperepl gate (variant discriminator) ------------------------------ |
||||
set gate_script {puts [list CHECK tclshmachinery [info exists ::tclsh(istty)]]; exit 0} |
||||
set d_default [checks [probe gate_default $gate_script]] |
||||
set d_optout [checks [probe gate_optout $gate_script TCLSH_PIPEREPL 0]] |
||||
if {$opt(-variant) eq "plain"} { |
||||
#unpatched: no machinery regardless of the env var (even explicitly enabled) |
||||
asserteq $d_default tclshmachinery 0 "piperepl (plain, env unset)" |
||||
set d_on [checks [probe gate_on $gate_script TCLSH_PIPEREPL 1]] |
||||
asserteq $d_on tclshmachinery 0 "piperepl (plain, TCLSH_PIPEREPL=1)" |
||||
note "piperepl OK (plain): stock behaviour - no ::tclsh machinery with env unset or =1" |
||||
} else { |
||||
#punk kits: ACTIVE BY DEFAULT (machinery published), documented opt-out =0 |
||||
asserteq $d_default tclshmachinery 1 "piperepl ($opt(-variant), env unset - default must be ON)" |
||||
asserteq $d_optout tclshmachinery 0 "piperepl ($opt(-variant), TCLSH_PIPEREPL=0 opt-out)" |
||||
note "piperepl OK ($opt(-variant)): active by default, disabled via TCLSH_PIPEREPL=0" |
||||
} |
||||
|
||||
file delete -force $scratch |
||||
puts "family_check OK: $opt(-variant) $kitname self-contained (scratch-dir probes, scrubbed env)" |
||||
exit 0 |
||||
Loading…
Reference in new issue