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.
346 lines
15 KiB
346 lines
15 KiB
#!/usr/bin/env tclsh |
|
#suite_tcl86 dev driver (G-099) - forked from suite_tcl90 (G-096/G-102 shape; |
|
#duplication-with-a-note is the recorded starting posture - shared scaffolding is |
|
#factored out only when this second consumer makes the right shape obvious). |
|
#Stages the tracked zig recipe into ../_build/suite_tcl86, arranges sources from |
|
#LIVE fossil checkouts, and delegates the build/test pipeline to the staged zig |
|
#recipe's steps. |
|
# |
|
#This is the FOSSIL DEV FLOW - convenient live-branch work against checkouts. The |
|
#equivalent no-tclsh flow is 'zig build stage|bootstrap' from the suite dir |
|
#(build86.zig bootstrap mode fetching the build.zig.zon pins). |
|
# |
|
#Usage: tclsh suite.tcl build ?options? |
|
# tclsh suite.tcl test ?-testargs {tcltest args}? |
|
# tclsh suite.tcl clean |
|
#Options: |
|
# -zig <path> zig executable (default: $env(PUNK_ZIG), else the sources.config |
|
# zigpin, else 'zig' on PATH) |
|
# -optimize <mode> Debug|ReleaseSafe|ReleaseFast|ReleaseSmall (default ReleaseFast) |
|
# -tclbranch <branch> override the 'tcl' ref from sources.config for this run |
|
# (default: core-8-6-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. 'build' default: {install install-libraries |
|
# smoke tklib tcllib tcllibc} (runtimes + companions + Tk + |
|
# script library + smokes, then the G-100 dependency set: |
|
# tklib/tcllib installed by their own installers and the |
|
# critcl-built tcllibc accelerators). |
|
# 'test' default: {test-gate} (the 8.6 core suite gate vs the |
|
# tracked expected_test_failures baseline; first census via |
|
# -zigargs {-Dtestmode=record}). Also: test-thread, test-tclvfs, |
|
# test-libraries (G-107-pattern policy tiers), test-tcllib, |
|
# test-tklib, and the OPT-IN test-tk (full Tk suite: maps |
|
# windows on the interactive desktop, tens of minutes). |
|
# -zigargs <list> extra args appended to the zig build invocation |
|
# |
|
#The build area lives entirely under src/buildsuites/_build (VCS-ignored). Fossil |
|
#clones live in the punkshell-owned machine-level store ~/.punkshell/fossils |
|
#(shared with suite_tcl90 - tcl/tclthread/tclvfs clone names are common). |
|
#Checkouts use FOSSIL_HOME=<stage> so the user's global fossil config db records |
|
#nothing. 'clean' wipes the stage; the store lives outside it. |
|
|
|
set suiteroot [file dirname [file normalize [info script]]] |
|
set suitename [file tail $suiteroot] |
|
#stage derived from the suite FOLDER name so a copied tree (copy-and-tweak workflow, |
|
#see sources.config) stages into its own _build/<name> - copies stay isolated. |
|
set stage [file normalize [file join $suiteroot .. _build $suitename]] |
|
set builddir [file join $stage build] |
|
|
|
proc log {msg} {puts stdout "$::suitename: $msg"; flush stdout} |
|
proc fail {msg} {puts stderr "$::suitename 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" |
|
} |
|
} |
|
|
|
#-- sources.config load --------------------------------------------------- |
|
#Declared in sources.config (the copy-and-tweak surface for the LIVE-checkout dev |
|
#flow - see its header; build.zig.zon is the equivalent PINNED surface for the |
|
#no-tclsh flow). Parsed as line records - never executed. |
|
#Record grammar incl. the G-104 self-description records: see |
|
#src/buildsuites/README.md ('make.tcl buildsuite list/info' reads the same records). |
|
proc load_sources_config {path} { |
|
set config [dict create sources [dict create] description "" products [list] docs [list] zigpin ""] |
|
set f [open $path r]; set data [read $f]; close $f |
|
set ln 0 |
|
foreach line [split $data \n] { |
|
incr ln |
|
set line [string trim $line] |
|
if {$line eq "" || [string index $line 0] eq "#"} {continue} |
|
if {[catch {llength $line} len]} { |
|
fail "sources.config line $ln: not a well-formed record: $line" |
|
} |
|
switch -- [lindex $line 0] { |
|
source { |
|
if {$len != 6} { |
|
fail "sources.config line $ln: expected 'source <name> <kind> <url> <ref> <dir>' - got: $line" |
|
} |
|
lassign $line -> name kind url ref dir |
|
if {$kind ni {fossil git}} { |
|
fail "sources.config line $ln: unknown kind '$kind' (expected fossil|git)" |
|
} |
|
dict set config sources $name [dict create kind $kind url $url ref $ref dir $dir] |
|
} |
|
description { |
|
dict set config description [join [lrange $line 1 end] " "] |
|
} |
|
product { |
|
dict lappend config products [join [lrange $line 1 end] " "] |
|
} |
|
doc { |
|
dict lappend config docs [lindex $line 1] |
|
} |
|
zigpin { |
|
dict set config zigpin [lindex $line 1] |
|
} |
|
default { |
|
fail "sources.config line $ln: unknown record type '[lindex $line 0]' (expected source|description|product|doc|zigpin)" |
|
} |
|
} |
|
} |
|
return $config |
|
} |
|
set suiteconfig [load_sources_config [file join $suiteroot sources.config]] |
|
set sources [dict get $suiteconfig sources] |
|
|
|
#-- 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 {} |
|
-refresh 0 |
|
-steps {install install-libraries smoke tklib tcllib tcllibc} |
|
-testargs {} |
|
-zigargs {} |
|
-repofolder {} |
|
-all 0 |
|
} |
|
set explicitopts {} |
|
set opt(-seedfossils) [file normalize [file join $env(HOME) .fossils]] |
|
#zig resolution: -zig option > PUNK_ZIG env > the sources.config zigpin record |
|
#(projectroot-relative; single source of truth shared with 'make.tcl buildsuite |
|
#info') > 'zig' on PATH. The recipe targets the pinned zig 0.16 API (as |
|
#suite_tcl90 - see its README Lineage). |
|
if {[dict get $suiteconfig zigpin] ne ""} { |
|
set pinned_zig [file normalize [file join $suiteroot .. .. .. [dict get $suiteconfig zigpin]]] |
|
} else { |
|
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 |
|
lappend explicitopts $k |
|
} |
|
|
|
#suite-owned clone store resolution: -repofolder > PUNK_FOSSIL_STORE > ~/.punkshell/fossils |
|
#(shared with suite_tcl90 - see its suite.tcl for the rationale record) |
|
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] |
|
} |
|
|
|
#Hermetic child shells: the suite-built tclsh must not see the user's machine-level |
|
#package paths (TCLLIBPATH/TCL_LIBRARY misdirect installer paths and risk |
|
#false-positive smokes; TCL<major>_<minor>_TM_PATH seeds tm.tcl's module roots and |
|
#is the quiet one - this machine points TCL8_6_TM_PATH at repo/foreign module trees, |
|
#which shadowed suite-installed tcllib packages until the G-100 work caught it). |
|
#The zig recipe scrubs the same list per built-shell Run step (build_common.zig |
|
#tcl_env_vars - keep the two lists in step). |
|
foreach ev {TCLLIBPATH TCL_LIBRARY TK_LIBRARY |
|
TCL8_0_TM_PATH TCL8_1_TM_PATH TCL8_2_TM_PATH TCL8_3_TM_PATH |
|
TCL8_4_TM_PATH TCL8_5_TM_PATH TCL8_6_TM_PATH TCL8_7_TM_PATH |
|
TCL9_0_TM_PATH TCL9_1_TM_PATH} { |
|
if {[info exists env($ev)]} { |
|
log "unsetting inherited \$env($ev) for hermetic child shells" |
|
unset env($ev) |
|
} |
|
} |
|
|
|
proc run_zig_steps {steps {extraopts {}}} { |
|
#drive the STAGED recipe (cwd = staged build dir, per-zig-version cache, |
|
#forward-slash prefix - suite_tcl90 parity) |
|
global opt builddir stage |
|
if {![file exists [file join $builddir build86.zig]]} { |
|
fail "no staged recipe at $builddir - run 'suite.tcl build' first" |
|
} |
|
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 (suite_tcl90-observed stale/duplicate artifacts in the link). |
|
set cachedir ".zig-cache-[string map {+ _ / _ : _} $zigv]" |
|
set savedpwd [pwd] |
|
cd $builddir |
|
run $opt(-zig) build --build-file build86.zig --cache-dir $cachedir --prefix [file join $stage out] -Doptimize=$opt(-optimize) {*}$extraopts {*}$steps |
|
cd $savedpwd |
|
} |
|
|
|
if {$action eq "clean"} { |
|
log "removing $stage (the clone store at $fossildir is untouched)" |
|
file delete -force $stage |
|
exit 0 |
|
} |
|
|
|
if {$action eq "test"} { |
|
#Delegates to the recipe's test steps. Default step: test-gate (8.6 core |
|
#testsuite gated on parsed totals vs the tracked expected_test_failures |
|
#baseline - pending the first census; the 9.0.5 census does not transfer). |
|
#-j1: independent zig steps must not run timing-sensitive suites in parallel. |
|
set extraopts {-j1} |
|
if {[llength $opt(-testargs)]} { |
|
lappend extraopts -Dtestargs=$opt(-testargs) |
|
} |
|
lappend extraopts {*}$opt(-zigargs) |
|
set teststeps [expr {"-steps" in $explicitopts ? $opt(-steps) : {test-gate}}] |
|
run_zig_steps $teststeps $extraopts |
|
log "test steps done ([join $teststeps {, }])" |
|
exit 0 |
|
} |
|
|
|
#-- action: build ---------------------------------------------------------- |
|
|
|
#-- fossil environment ---------------------------------------------------- |
|
#Checkout registrations go to a stage-local config db, not the user's global one |
|
#(fossil scratchpad registry pollution guard). 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 |
|
} |
|
} elseif {$opt(-refresh)} { |
|
log "refreshing $name.fossil (pull)" |
|
run fossil pull -R $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 |
|
} |
|
#provenance: materialize manifest.uuid regardless of the upstream repo's |
|
#versioned 'manifest' setting (suite_tcl90 convention - local checkout-scoped |
|
#setting 'u' generates manifest.uuid immediately and keeps it current). |
|
set savedpwd [pwd] |
|
cd $dir |
|
run fossil settings manifest u |
|
cd $savedpwd |
|
} |
|
|
|
proc git_source {name url ref dir} { |
|
#clone (or leave) a git checkout pinned at ref (critcl - the recipe's tcllibc |
|
#step consumes it from the stage; suite_tcl90 convention) |
|
global opt |
|
if {![file isdirectory [file join $dir .git]]} { |
|
log "cloning $name (git) -> $dir" |
|
run git clone --quiet $url $dir |
|
} elseif {$opt(-refresh)} { |
|
run git -C $dir fetch --quiet |
|
} |
|
run git -C $dir checkout --quiet $ref |
|
} |
|
|
|
#-- 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 (per-zig-version; windows can hold transient locks on |
|
#recently-used cache trees). Item list mirrors the zig bootstrap mode's |
|
#recipe_items (build86.zig bootstrapMode). |
|
log "staging recipe -> $builddir" |
|
file mkdir $builddir |
|
foreach item {build86.zig build_common.zig build_zlib86 build_tclthread86 build_tclvfs86 build_tk86 critcl_zig.config expected_test_failures.txt expected_test_failures_thread.txt expected_test_failures_tclvfs.txt src tools} { |
|
file delete -force [file join $builddir $item] |
|
file copy [file join $suiteroot $item] $builddir |
|
} |
|
|
|
#-- sources --------------------------------------------------------------- |
|
foreach required {tcl tclthread tclvfs tk tklib tcllib critcl} { |
|
if {![dict exists $sources $required]} { |
|
fail "sources.config: missing required source record '$required'" |
|
} |
|
} |
|
|
|
dict for {name s} $sources { |
|
set ref [dict get $s ref] |
|
if {$name eq "tcl" && $opt(-tclbranch) ne ""} { |
|
set ref $opt(-tclbranch) ;#per-run CLI override of the declared tcl ref |
|
} |
|
switch -- [dict get $s kind] { |
|
fossil {fossil_source $name [dict get $s url] $ref [file join $stage [dict get $s dir]]} |
|
git {git_source $name [dict get $s url] $ref [file join $stage [dict get $s dir]]} |
|
} |
|
} |
|
|
|
#zlib/libtommath: 8.6 compiles the tcl tree's own vendored copies in place |
|
#(tcl86/compat/zlib, tcl86/libtommath) - arrangement differs from 9.0 (see README |
|
#DERIVATION); nothing extra to stage. |
|
|
|
#-- version facts for the final log ---------------------------------------- |
|
set f [open [file join $stage tcl86 manifest.uuid] r]; set uuid [read $f]; close $f |
|
set f [open [file join $stage tcl86 generic tcl.h] r]; set tclh [read $f]; close $f |
|
if {![regexp {#\s*define\s+TCL_PATCH_LEVEL\s+"([^"]+)"} $tclh -> patchlevel]} {fail "TCL_PATCH_LEVEL not found in tcl.h"} |
|
log "sources: tcl $patchlevel (checkout [string range $uuid 0 11]...)" |
|
|
|
#-- build (staged recipe steps) ------------------------------------------- |
|
run_zig_steps $opt(-steps) $opt(-zigargs) |
|
|
|
log "PASS - built $patchlevel (checkout [string range $uuid 0 11]...) -> $stage/out"
|
|
|