You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
310 lines
16 KiB
310 lines
16 KiB
#!/usr/bin/env tclsh |
|
#suite_tcl90 driver (G-096): stage the tracked zig recipe into ../_build/suite_tcl90, |
|
#arrange sources, generate the configure-produced files fresh checkouts lack, build, |
|
#and smoke-test the result. |
|
# |
|
#Usage: tclsh suite.tcl build ?options? |
|
# tclsh suite.tcl test ?-testargs {tcltest args}? (e.g -testargs {-file "assocd.test util.test"}) |
|
# tclsh suite.tcl clean |
|
#Options: |
|
# -zig <path> zig executable (default: $env(PUNK_ZIG), else 'zig' on PATH) |
|
# -optimize <mode> Debug|ReleaseSafe|ReleaseFast|ReleaseSmall (default ReleaseFast) |
|
# -tclbranch <branch> tcl branch/tag to open (default core-9-0-branch) |
|
# -refresh <0|1> pull clones + fossil update existing source checkouts (default 0) |
|
# -repofolder <dir> fossil clone store (default ~/.punkshell/fossils; env PUNK_FOSSIL_STORE) |
|
# -seedfossils <dir> read-only seed collection for missing clones (default ~/.fossils; "" disables) |
|
# -all <0|1> with 'clean': reserved (the clone store lives outside the stage) |
|
# -steps <list> zig build steps (default {install install-libraries make-zipfs}) |
|
# |
|
#The build area lives entirely under src/buildsuites/_build (VCS-ignored via the |
|
#existing _build globs). Fossil clones live in the PUNKSHELL-OWNED machine-level |
|
#store ~/.punkshell/fossils (G-098 decisions 2026-07-20: independent of any personal |
|
#fossil collection AND outside deletable _build-class dirs - clone dbs are caches, |
|
#not build output). Missing clones are seeded READ-ONLY by file copy from a local |
|
#collection when available (-seedfossils, default ~/.fossils; the seed is never |
|
#written - the copy is pulled current), else network-cloned. Store override: |
|
#-repofolder or PUNK_FOSSIL_STORE (punk::config-registered - see 'help env'). |
|
#Checkouts use FOSSIL_HOME=<stage> so the user's global fossil config db records |
|
#nothing. 'clean'/'clean -all 1' wipe the stage; the store lives outside it. |
|
|
|
proc log {msg} {puts stdout "suite_tcl90: $msg"; flush stdout} |
|
proc fail {msg} {puts stderr "suite_tcl90 ERROR: $msg"; flush stderr; exit 1} |
|
|
|
proc run {args} { |
|
#stream output; abort on nonzero exit |
|
log "run: $args" |
|
if {[catch {exec {*}$args >@stdout 2>@stderr} err opts]} { |
|
set code [dict get $opts -errorcode] |
|
if {[lindex $code 0] eq "CHILDSTATUS"} { |
|
fail "command failed (exit [lindex $code 2]): $args" |
|
} |
|
fail "command failed: $args\n$err" |
|
} |
|
} |
|
|
|
set suiteroot [file dirname [file normalize [info script]]] |
|
set stage [file normalize [file join $suiteroot .. _build suite_tcl90]] |
|
|
|
#-- options --------------------------------------------------------------- |
|
set action [lindex $argv 0] |
|
if {$action ni {build test clean}} { |
|
puts stderr "usage: tclsh suite.tcl build|test|clean ?options? (see header)" |
|
exit 2 |
|
} |
|
array set opt { |
|
-optimize ReleaseFast |
|
-tclbranch core-9-0-branch |
|
-refresh 0 |
|
-steps {install install-libraries make-zipfs} |
|
-testargs {} |
|
-repofolder {} |
|
-all 0 |
|
} |
|
set opt(-seedfossils) [file normalize [file join $env(HOME) .fossils]] |
|
#zig resolution: -zig option > PUNK_ZIG env > the suite's pinned toolchain under |
|
#bin/tools (zig 0.16.0 official release - hosted on punkbin, minisign-verified; |
|
#the recipe is 0.16-API and does NOT build under 0.14/0.15 - see README Lineage) |
|
#> 'zig' on PATH. |
|
set pinned_zig [file normalize [file join $suiteroot .. .. .. bin tools zig-x86_64-windows-0.16.0 zig.exe]] |
|
if {[info exists env(PUNK_ZIG)]} { |
|
set opt(-zig) $env(PUNK_ZIG) |
|
} elseif {[file exists $pinned_zig]} { |
|
set opt(-zig) $pinned_zig |
|
} else { |
|
set opt(-zig) "zig" |
|
} |
|
foreach {k v} [lrange $argv 1 end] { |
|
if {![info exists opt($k)]} {fail "unknown option '$k'"} |
|
set opt($k) $v |
|
} |
|
|
|
#suite-owned clone store resolution: -repofolder > PUNK_FOSSIL_STORE > ~/.punkshell/fossils |
|
#The default is a punkshell-owned MACHINE-LEVEL cache outside the repo tree: _build |
|
#class dirs are idiomatically deletable (git clean -fdx included) and clone dbs are |
|
#caches, not build output. ~/... on all platforms is a deliberate user preference |
|
#(cross-platform doc simplicity) despite windows convention. PUNK_FOSSIL_STORE is a |
|
#punk::config-registered env var ('help env' documents it in punkshell). |
|
if {$opt(-repofolder) ne ""} { |
|
set fossildir [file normalize $opt(-repofolder)] |
|
} elseif {[info exists env(PUNK_FOSSIL_STORE)] && $env(PUNK_FOSSIL_STORE) ne ""} { |
|
set fossildir [file normalize $env(PUNK_FOSSIL_STORE)] |
|
} else { |
|
if {[info exists env(HOME)] && $env(HOME) ne ""} { |
|
set homedir $env(HOME) |
|
} elseif {[info exists env(USERPROFILE)] && $env(USERPROFILE) ne ""} { |
|
set homedir $env(USERPROFILE) |
|
} elseif {![catch {file home} h]} { |
|
set homedir $h |
|
} else { |
|
fail "cannot determine home directory for the default fossil store (set PUNK_FOSSIL_STORE or -repofolder)" |
|
} |
|
set fossildir [file join [file normalize $homedir] .punkshell fossils] |
|
} |
|
|
|
if {$action eq "clean"} { |
|
log "removing $stage (the clone store at $fossildir is untouched)" |
|
file delete -force $stage |
|
exit 0 |
|
} |
|
|
|
if {$action eq "test"} { |
|
#Exercise the Tcl core test suite on the suite-built static shell (all.tcl in the |
|
#staged checkout's tests dir; pass tcltest selection via -testargs). all.tcl's |
|
#exit code reflects test failures on modern tcl; output is streamed regardless. |
|
set exe [file join $stage out bin tclsh90s.exe] |
|
set testsdir [file join $stage tcl905 tests] |
|
if {![file exists $exe]} {fail "no built shell at $exe - run 'suite.tcl build' first"} |
|
if {![file isdirectory $testsdir]} {fail "no tcl tests dir at $testsdir - run 'suite.tcl build' first"} |
|
log "tcl testsuite on $exe [expr {[llength $opt(-testargs)] ? $opt(-testargs) : "(full suite)"}]" |
|
set savedpwd [pwd] |
|
cd $testsdir |
|
set rc [catch {exec $exe all.tcl {*}$opt(-testargs) >@stdout 2>@stderr} err] |
|
cd $savedpwd |
|
if {$rc} {fail "tcl testsuite reported failure: $err"} |
|
log "tcl testsuite run complete (see output above for any FAILED lines)" |
|
exit 0 |
|
} |
|
|
|
#-- fossil environment ---------------------------------------------------- |
|
#Checkout registrations go to a stage-local config db, not the user's global one |
|
#(agent-memory: fossil scratchpad registry pollution). Clones are still shared. |
|
file mkdir $stage |
|
set env(FOSSIL_HOME) $stage |
|
file mkdir $fossildir |
|
|
|
proc fossil_source {name url branch dir} { |
|
#ensure <store>/<name>.fossil exists (read-only seed copy, else network clone) and |
|
#open it at branch in dir |
|
global fossildir opt |
|
set repo [file join $fossildir $name.fossil] |
|
if {![file exists $repo]} { |
|
set seeded 0 |
|
if {$opt(-seedfossils) ne ""} { |
|
set seed [file join $opt(-seedfossils) $name.fossil] |
|
if {[file exists $seed]} { |
|
log "seeding $name.fossil into the suite store from $seed (read-only copy)" |
|
file copy $seed $repo |
|
#the seed may be stale - freshen OUR copy (the seed is never written) |
|
run fossil pull -R $repo |
|
set seeded 1 |
|
} |
|
} |
|
if {!$seeded} { |
|
log "cloning $url -> $repo" |
|
run fossil clone $url $repo |
|
} |
|
} |
|
if {![file exists [file join $dir _FOSSIL_]] && ![file exists [file join $dir .fslckout]]} { |
|
file mkdir $dir |
|
set savedpwd [pwd] |
|
cd $dir |
|
#--nested: the stage lives inside the punkshell checkout tree |
|
run fossil open $repo $branch --nested |
|
cd $savedpwd |
|
} elseif {$opt(-refresh)} { |
|
set savedpwd [pwd] |
|
cd $dir |
|
run fossil pull -R $repo |
|
run fossil update $branch |
|
cd $savedpwd |
|
} |
|
} |
|
|
|
#-- stage the recipe ------------------------------------------------------ |
|
#Per-item sync (not a wholesale delete of the build dir): zig cache dirs live in the |
|
#build dir and are kept - they are per-zig-version (see --cache-dir below), and windows |
|
#can hold transient locks on recently-used cache trees. |
|
set builddir [file join $stage build] |
|
log "staging recipe -> $builddir" |
|
file mkdir $builddir |
|
foreach item {build905.zig build_libtommath build_zlib build_tclvfs build_tclthread build_tk src tools} { |
|
file delete -force [file join $builddir $item] |
|
file copy [file join $suiteroot $item] $builddir |
|
} |
|
|
|
#-- sources --------------------------------------------------------------- |
|
fossil_source tcl https://core.tcl-lang.org/tcl $opt(-tclbranch) [file join $stage tcl905] |
|
fossil_source tclthread https://core.tcl-lang.org/thread trunk [file join $stage tclthread] |
|
fossil_source tclvfs https://core.tcl-lang.org/tclvfs trunk [file join $stage tclvfs] |
|
#G-098: Tk + companion script libraries. tklib is pure-tcl (installed by its own |
|
#installer where that matters); tcllib's accelerators (tcllibc) are built via critcl. |
|
fossil_source tk https://core.tcl-lang.org/tk core-9-0-branch [file join $stage tk9] |
|
fossil_source tklib https://core.tcl-lang.org/tklib trunk [file join $stage tklib] |
|
fossil_source tcllib https://core.tcl-lang.org/tcllib trunk [file join $stage tcllib] |
|
|
|
#zlib: use the tcl tree's own vendored copy (version-matched; includes contrib/minizip) |
|
set zlibdir [file join $stage zlib] |
|
if {![file isdirectory $zlibdir]} { |
|
log "staging zlib from tcl compat/zlib" |
|
file copy [file join $stage tcl905 compat zlib] $zlibdir |
|
} |
|
#vqtcl/vlerq: removed from the suite (user 2026-07-20) - old-tclkit experiment with no |
|
#confirmed public upstream. Future tclkit work: TEMP_REFERENCE/metakit + KitCreator. |
|
|
|
#-- generated files a fresh tcl checkout lacks (normally configure/prepare products) -- |
|
set tcldir [file join $stage tcl905] |
|
#tclUuid.h: '#define TCL_VERSION_UUID \' + manifest.uuid content |
|
set f [open [file join $tcldir manifest.uuid] r]; set uuid [read $f]; close $f |
|
set f [open [file join $tcldir win tclUuid.h] w] |
|
fconfigure $f -translation lf |
|
puts -nonewline $f "#define TCL_VERSION_UUID \\\n$uuid" |
|
close $f |
|
#tclsh.exe.manifest from .in: TCL_WIN_VERSION = TCL_VERSION . releaselevel . patchlevel-stripped |
|
set f [open [file join $tcldir generic tcl.h] r]; set tclh [read $f]; close $f |
|
if {![regexp {#\s*define\s+TCL_VERSION\s+"([^"]+)"} $tclh -> tclversion]} {fail "TCL_VERSION not found in tcl.h"} |
|
if {![regexp {#\s*define\s+TCL_PATCH_LEVEL\s+"([^"]+)"} $tclh -> patchlevel]} {fail "TCL_PATCH_LEVEL not found in tcl.h"} |
|
set rlevel [expr {[string match *a* $patchlevel] ? 0 : ([string match *b* $patchlevel] ? 1 : 2)}] |
|
set winver "$tclversion.$rlevel.[string map {a {} b {} . {}} $patchlevel]" |
|
set f [open [file join $tcldir win tclsh.exe.manifest.in] r]; set manifest [read $f]; close $f |
|
set manifest [string map [list @TCL_WIN_VERSION@ $winver @MACHINE@ AMD64] $manifest] |
|
set f [open [file join $tcldir win tclsh.exe.manifest] w] |
|
fconfigure $f -translation lf |
|
puts -nonewline $f $manifest |
|
close $f |
|
log "generated tclUuid.h + tclsh.exe.manifest (TCL_WIN_VERSION $winver, patchlevel $patchlevel)" |
|
|
|
#thread.rc: the zig rc compile does not receive the makefile's include paths; give the |
|
#version resource script the tcl header it needs (idempotent scripted edit of the |
|
#staged checkout - the historical recipe carried this as an uncommitted tweak). |
|
set rcfile [file join $stage tclthread win thread.rc] |
|
set f [open $rcfile r]; set rc [read $f]; close $f |
|
if {![string match "*tcl905/generic/tcl.h*" $rc]} { |
|
set rc [string map [list "#include <winver.h>" "#include <winver.h>\n#include \"../../tcl905/generic/tcl.h\""] $rc] |
|
set f [open $rcfile w]; fconfigure $f -translation lf; puts -nonewline $f $rc; close $f |
|
log "thread.rc: inserted tcl.h include for the version resource" |
|
} |
|
|
|
#tk generated files (G-098): tkUuid.h from manifest.uuid; wish.exe.manifest from its |
|
#.in (tk.rc depends on it) - same configure-product class as the tcl ones above. |
|
set tkdir [file join $stage tk9] |
|
set f [open [file join $tkdir manifest.uuid] r]; set tkuuid [read $f]; close $f |
|
set f [open [file join $tkdir win tkUuid.h] w] |
|
fconfigure $f -translation lf |
|
puts -nonewline $f "#define TK_VERSION_UUID \\\n$tkuuid" |
|
close $f |
|
set f [open [file join $tkdir generic tk.h] r]; set tkh [read $f]; close $f |
|
if {![regexp {#\s*define\s+TK_VERSION\s+"([^"]+)"} $tkh -> tkversion]} {fail "TK_VERSION not found in tk.h"} |
|
if {![regexp {#\s*define\s+TK_PATCH_LEVEL\s+"([^"]+)"} $tkh -> tkpatchlevel]} {fail "TK_PATCH_LEVEL not found in tk.h"} |
|
set tkrlevel [expr {[string match *a* $tkpatchlevel] ? 0 : ([string match *b* $tkpatchlevel] ? 1 : 2)}] |
|
set tkwinver "$tkversion.$tkrlevel.[string map {a {} b {} . {}} $tkpatchlevel]" |
|
set f [open [file join $tkdir win wish.exe.manifest.in] r]; set m [read $f]; close $f |
|
set m [string map [list @TK_WIN_VERSION@ $tkwinver @MACHINE@ AMD64] $m] |
|
set f [open [file join $tkdir win wish.exe.manifest] w] |
|
fconfigure $f -translation lf |
|
puts -nonewline $f $m |
|
close $f |
|
log "tk prepared (patchlevel $tkpatchlevel, TK_WIN_VERSION $tkwinver)" |
|
|
|
#-- build ----------------------------------------------------------------- |
|
set zigv [exec $opt(-zig) version] |
|
log "zig: $opt(-zig) ($zigv)" |
|
#Per-zig-version local cache: object caches must never be shared across zig versions |
|
#(observed producing stale/duplicate artifacts in the link; user-confirmed hazard). |
|
set cachedir ".zig-cache-[string map {+ _ / _ : _} $zigv]" |
|
set savedpwd [pwd] |
|
cd $builddir |
|
run $opt(-zig) build --build-file build905.zig --cache-dir $cachedir --prefix [file join $stage out] -Doptimize=$opt(-optimize) {*}$opt(-steps) |
|
cd $savedpwd |
|
|
|
#-- tk pkgIndex (makefile.vc install-binaries convention) ------------------ |
|
set tkpkgdir [file join $stage out lib tk$tkversion] |
|
if {[file isdirectory $tkpkgdir]} { |
|
set f [open [file join $tkpkgdir pkgIndex.tcl] w] |
|
fconfigure $f -translation lf |
|
puts $f "if {\[catch {package present Tcl 9.0-}\]} return" |
|
puts $f "package ifneeded tk $tkpatchlevel \[list load \[file normalize \[file join \$dir .. .. bin tcl9tk90.dll\]\]\]" |
|
puts $f "package ifneeded Tk $tkpatchlevel \[list load \[file normalize \[file join \$dir .. .. bin tcl9tk90.dll\]\]\]" |
|
close $f |
|
log "tk pkgIndex.tcl written ($tkpkgdir)" |
|
} |
|
|
|
#-- smoke ----------------------------------------------------------------- |
|
set exe [file join $stage out bin tclsh90s.exe] |
|
set zexe [file join $stage out bin tclsh90szip.exe] |
|
foreach {label path script} [list \ |
|
static $exe {puts [info patchlevel]} \ |
|
zip $zexe {puts "[info patchlevel] tz=[clock format 0 -gmt 0 -format %Z] auto=[llength [info procs auto_load]]"} \ |
|
] { |
|
if {![file exists $path]} {fail "$label shell missing: $path"} |
|
set out [exec $path << "$script; exit"] |
|
log "$label shell: $out" |
|
if {![string match "$patchlevel*" $out]} {fail "$label shell patchlevel mismatch: got '$out' want '$patchlevel'"} |
|
} |
|
#-- tklib install (G-098) -------------------------------------------------- |
|
#tklib is pure-tcl but its installer is NOT a straight copy: module exclusions and |
|
#generation of the aggregating pkgIndex.tcl (gen_main_index). Run it in batch mode |
|
#(packages only) with the suite-built shell; default paths derive from that shell, |
|
#landing the packages under <out>/lib/<tklib-version-dir>. |
|
if {![llength [glob -nocomplain [file join $stage out lib tklib*]]]} { |
|
log "installing tklib (batch, packages only) via its own installer" |
|
set savedpwd [pwd] |
|
cd [file join $stage tklib] |
|
run $exe installer.tcl -no-gui -no-wait -pkgs -no-apps -no-html -no-nroff -no-examples |
|
cd $savedpwd |
|
} |
|
set tkliblanded [glob -nocomplain [file join $stage out lib tklib*]] |
|
if {![llength $tkliblanded]} {fail "tklib install did not land under [file join $stage out lib]"} |
|
set tksmoke [exec $exe << {package require Tk; wm withdraw .; puts "tooltip: [package require tooltip]"; destroy .; exit}] |
|
log "tklib: [file tail [lindex $tkliblanded 0]] installed; smoke $tksmoke" |
|
|
|
log "PASS - built $patchlevel (checkout [string range $uuid 0 11]..., zig $zigv) -> $stage/out"
|
|
|