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.
284 lines
14 KiB
284 lines
14 KiB
package require tcltest |
|
|
|
#Piped characterization of the make.tcl project-version bake gate (added 2026-08-06). |
|
#The project version is a bake input: punkkit-stamp.toml project_version and the |
|
#versioned-scheme output names are read from punkproject.toml at bake time, so the |
|
#kit-assembling subcommands refuse to proceed with a non-interactive stdin when a |
|
#bump looks pending - src/ commits since punkproject.toml last changed, none staged - |
|
#unless -expect-projectversion asserts the intended version, and always refuse a |
|
#mismatched assertion. -confirm 0 deliberately does not waive the gate. |
|
#Runs make.tcl under the built punk executable's 'script' subcommand with output |
|
#captured through a pipe and stdin half-closed - a non-interactive stdin by |
|
#construction, exactly the population the gate exists to stop. |
|
# - the 'check' and 'projectversion' pins run against this WORKING TREE |
|
# - the gate VERDICT pins run against throwaway fixture projects under tcltest |
|
# temporaryDirectory, each carrying a copy of the working-tree make.tcl and of |
|
# src/bootsupport so punkboot::utils resolves. The git fixture is built at |
|
# version 0.1.0 with one src/ commit after the last punkproject.toml commit - |
|
# the pending-bump state; the no-git fixture exercises the documented NOTE |
|
# degradation. Downstream-of-gate outcomes in fixtures - no runtimes to bake, |
|
# no VCS for the bake workdir - are deliberately not pinned: the pins assert |
|
# only the gate's own contract. |
|
#Target executable resolved from env(PUNK_SHELL_TEST_EXE), else |
|
#<projectroot>/bin/punk902z.exe then <projectroot>/bin/punkshell902. Skipped |
|
#(constraint punkexeavailable) if none found; fixture tests additionally need git |
|
#on PATH (constraint gitavailable). |
|
|
|
namespace eval ::testspace { |
|
namespace import ::tcltest::* |
|
|
|
variable testdir [file dirname [file normalize [info script]]] |
|
#<projectroot>/src/tests/shell/testsuites/punkexe -> 5 levels up to <projectroot> |
|
variable projectroot [file normalize [file join $testdir .. .. .. .. ..]] |
|
variable maketcl [file join $projectroot src make.tcl] |
|
|
|
variable punkexe "" |
|
if {[info exists ::env(PUNK_SHELL_TEST_EXE)] && $::env(PUNK_SHELL_TEST_EXE) ne ""} { |
|
set punkexe [file normalize $::env(PUNK_SHELL_TEST_EXE)] |
|
} else { |
|
foreach candidate [list [file join $projectroot bin punk902z.exe] [file join $projectroot bin punkshell902]] { |
|
if {[file exists $candidate]} { |
|
set punkexe $candidate |
|
break |
|
} |
|
} |
|
} |
|
testConstraint punkexeavailable [expr {$punkexe ne "" && [file exists $punkexe]}] |
|
testConstraint gitavailable [expr {[llength [auto_execok git]] > 0}] |
|
|
|
variable maketcl_run_timeout_ms 60000 |
|
|
|
variable runstate |
|
array set runstate {} |
|
|
|
proc maketcl_run_read {chan} { |
|
variable runstate |
|
append runstate(output) [read $chan] |
|
if {[chan eof $chan]} { |
|
chan event $chan readable {} |
|
set runstate(done) eof |
|
} |
|
} |
|
|
|
#Run <punkexe> script <somemaketcl> <subcommand...> with output captured through a |
|
#pipe (stdin half-closed for immediate EOF - the gate must see a non-interactive |
|
#stdin). scriptpath defaults to the working tree's src/make.tcl; the fixture tests |
|
#pass their fixture's copy. Returns dict: timedout 0|1, exitcode <int|empty>, |
|
#output <combined stdout+stderr>. |
|
proc maketcl_run {cmdargs {scriptpath ""}} { |
|
variable runstate |
|
variable maketcl_run_timeout_ms |
|
variable punkexe |
|
variable maketcl |
|
if {$scriptpath eq ""} { |
|
set scriptpath $maketcl |
|
} |
|
array unset runstate |
|
set runstate(output) "" |
|
set runstate(done) "" |
|
|
|
set chan [open |[list $punkexe script $scriptpath {*}$cmdargs 2>@1] r+] |
|
chan configure $chan -blocking 0 -translation binary |
|
catch {chan close $chan write} ;#no stdin for the child - immediate EOF |
|
set timerid [after $maketcl_run_timeout_ms [list set [namespace current]::runstate(done) timeout]] |
|
chan event $chan readable [list [namespace current]::maketcl_run_read $chan] |
|
while {$runstate(done) eq ""} { |
|
vwait [namespace current]::runstate(done) |
|
} |
|
after cancel $timerid |
|
set timedout [expr {$runstate(done) eq "timeout"}] |
|
set exitcode "" |
|
if {$timedout} { |
|
catch {exec {*}[auto_execok taskkill] /F /T /PID [lindex [pid $chan] 0]} |
|
catch {chan close $chan} |
|
} else { |
|
chan configure $chan -blocking 1 |
|
if {[catch {chan close $chan} errdata errdict]} { |
|
set exitcode [lindex [dict get $errdict -errorcode] end] |
|
} else { |
|
set exitcode 0 |
|
} |
|
} |
|
return [dict create timedout $timedout exitcode $exitcode output $runstate(output)] |
|
} |
|
|
|
proc fixture_git {base args} { |
|
exec git -C $base -c user.name=fixture -c user.email=fixture@test -c commit.gpgsign=false -c init.defaultBranch=main {*}$args 2>@1 |
|
} |
|
|
|
#Minimal punk-project-shaped tree carrying a copy of the working-tree make.tcl and |
|
#of src/bootsupport. withgit builds the pending-bump state: version 0.1.0 |
|
#committed, then one src/ commit after it. |
|
proc fixture_new {dirtail withgit} { |
|
variable projectroot |
|
set base [file normalize [makeDirectory $dirtail]] |
|
file mkdir [file join $base src modules] [file join $base src lib] [file join $base lib] [file join $base modules] |
|
file copy [file join $projectroot src make.tcl] [file join $base src make.tcl] |
|
file copy [file join $projectroot src bootsupport] [file join $base src bootsupport] |
|
set fd [open [file join $base punkproject.toml] w] |
|
puts $fd "\[project\]" |
|
puts $fd "name = \"fixtureproj\"" |
|
puts $fd "version = \"0.1.0\"" |
|
close $fd |
|
set fd [open [file join $base CHANGELOG.md] w] |
|
puts $fd "# Changelog" |
|
puts $fd "" |
|
puts $fd "## \[0.1.0\] - 2026-08-06" |
|
puts $fd "- initial" |
|
close $fd |
|
if {$withgit} { |
|
fixture_git $base init -q -b main |
|
fixture_git $base add -A |
|
fixture_git $base commit -q -m "initial 0.1.0" |
|
set fd [open [file join $base src change.tcl] w] |
|
puts $fd "puts change" |
|
close $fd |
|
fixture_git $base add -A |
|
fixture_git $base commit -q -m "src change" |
|
} |
|
return $base |
|
} |
|
|
|
variable fixgit "" |
|
if {[testConstraint punkexeavailable] && [testConstraint gitavailable]} { |
|
set fixgit [fixture_new maketclpvgate_git 1] |
|
} |
|
variable fixnogit "" |
|
if {[testConstraint punkexeavailable]} { |
|
set fixnogit [fixture_new maketclpvgate_nogit 0] |
|
} |
|
|
|
proc has {out needle} { |
|
expr {[string first $needle $out] >= 0} |
|
} |
|
|
|
#added 2026-08-06 (agent, project-version gate) |
|
test maketcl_check_pvgate_status {make.tcl check reports the project-version bake gate with one of the two documented statuses, ESC-free}\ |
|
-constraints {punkexeavailable} -body { |
|
set r [maketcl_run {check}] |
|
set out [dict get $r output] |
|
set result [list] |
|
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
|
lappend result esc [regexp -all {\x1b} $out] |
|
lappend result line [regexp -line {^project-version bake gate: (ACTIVE|UNAVAILABLE)} $out] |
|
set result |
|
}\ |
|
-result {timedout 0 exitcode 0 esc 0 line 1} |
|
|
|
#added 2026-08-06 (agent, project-version gate) |
|
test maketcl_check_pvgate_active_contract {with a current bootsupport snapshot the gate is ACTIVE, states the bake-input relationship, the no-waiver rule and a current state}\ |
|
-constraints {punkexeavailable} -body { |
|
set r [maketcl_run {check}] |
|
set out [dict get $r output] |
|
set result [list] |
|
lappend result active [regexp -line {^project-version bake gate: ACTIVE\s*$} $out] |
|
lappend result bakeinput [has $out "BAKE INPUT"] |
|
lappend result nowaiver [has $out "-confirm 0 does not waive the gate"] |
|
lappend result state [regexp -line {^ current state: } $out] |
|
set result |
|
}\ |
|
-result {active 1 bakeinput 1 nowaiver 1 state 1} |
|
|
|
#added 2026-08-06 (agent, project-version gate) |
|
test maketcl_projectversion_advisory_read_only {make.tcl projectversion stays a read-only exit-0 advisory, ESC-free}\ |
|
-constraints {punkexeavailable} -body { |
|
set r [maketcl_run {projectversion}] |
|
set out [dict get $r output] |
|
set result [list] |
|
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
|
lappend result esc [regexp -all {\x1b} $out] |
|
lappend result header [has $out "project version check"] |
|
lappend result ppline [has $out "punkproject.toml version :"] |
|
set result |
|
}\ |
|
-result {timedout 0 exitcode 0 esc 0 header 1 ppline 1} |
|
|
|
#added 2026-08-06 (agent, project-version gate) |
|
test maketcl_pvgate_pending_flagless_aborts {pending-bump fixture: a flagless non-interactive bake aborts fast, naming the consequence and the assertion escape hatch}\ |
|
-constraints {punkexeavailable gitavailable} -body { |
|
variable fixgit |
|
set r [maketcl_run {bake -confirm 0} [file join $fixgit src make.tcl]] |
|
set out [dict get $r output] |
|
set result [list] |
|
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
|
lappend result pending [has $out "BAKE-WARNING: project-version bump may be PENDING"] |
|
lappend result consequence [has $out "BAKE INPUT"] |
|
lappend result hint [has $out "-expect-projectversion 0.1.0"] |
|
lappend result aborted [has $out "-aborted- (project-version bump appears pending"] |
|
set result |
|
}\ |
|
-result {timedout 0 exitcode 1 pending 1 consequence 1 hint 1 aborted 1} |
|
|
|
#added 2026-08-06 (agent, project-version gate) |
|
test maketcl_pvgate_assert_match_proceeds {pending-bump fixture: a matching -expect-projectversion satisfies the gate and the bake proceeds past it}\ |
|
-constraints {punkexeavailable gitavailable} -body { |
|
variable fixgit |
|
set r [maketcl_run {bake -confirm 0 -expect-projectversion 0.1.0} [file join $fixgit src make.tcl]] |
|
set out [dict get $r output] |
|
set result [list] |
|
lappend result timedout [dict get $r timedout] |
|
lappend result gateok [has $out "project-version gate: OK (asserted -expect-projectversion 0.1.0"] |
|
lappend result note [has $out "proceeding on the assertion"] |
|
lappend result gateabort [has $out "-aborted- (project-version"] |
|
set result |
|
}\ |
|
-result {timedout 0 gateok 1 note 1 gateabort 0} |
|
|
|
#added 2026-08-06 (agent, project-version gate) |
|
test maketcl_pvgate_assert_mismatch_aborts {a mismatched -expect-projectversion aborts before any kit work}\ |
|
-constraints {punkexeavailable gitavailable} -body { |
|
variable fixgit |
|
set r [maketcl_run {bake -confirm 0 -expect-projectversion 9.9.9} [file join $fixgit src make.tcl]] |
|
set out [dict get $r output] |
|
set result [list] |
|
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
|
lappend result mismatch [has $out "-expect-projectversion MISMATCH: asserted 9.9.9 but punkproject.toml says 0.1.0"] |
|
lappend result aborted [has $out "-aborted- (project-version assertion mismatch"] |
|
set result |
|
}\ |
|
-result {timedout 0 exitcode 1 mismatch 1 aborted 1} |
|
|
|
#added 2026-08-06 (agent, project-version gate) |
|
test maketcl_pvgate_bump_staged_proceeds {a staged-but-uncommitted bump passes the gate - bake reads the working-tree value}\ |
|
-constraints {punkexeavailable gitavailable} -body { |
|
variable fixgit |
|
set fd [open [file join $fixgit punkproject.toml] w] |
|
puts $fd "\[project\]" |
|
puts $fd "name = \"fixtureproj\"" |
|
puts $fd "version = \"0.2.0\"" |
|
close $fd |
|
set r [maketcl_run {bake -confirm 0} [file join $fixgit src make.tcl]] |
|
set out [dict get $r output] |
|
set result [list] |
|
lappend result timedout [dict get $r timedout] |
|
lappend result staged [has $out "bumped 0.1.0 -> 0.2.0, commit pending"] |
|
lappend result gateabort [has $out "-aborted- (project-version"] |
|
set result |
|
}\ |
|
-result {timedout 0 staged 1 gateabort 0} |
|
|
|
#added 2026-08-06 (agent, project-version gate) |
|
test maketcl_pvgate_nogit_note_degradation {no-VCS fixture: the gate degrades to the documented NOTE and does not block}\ |
|
-constraints {punkexeavailable} -body { |
|
variable fixnogit |
|
set r [maketcl_run {bake -confirm 0} [file join $fixnogit src make.tcl]] |
|
set out [dict get $r output] |
|
set result [list] |
|
lappend result timedout [dict get $r timedout] |
|
lappend result note [has $out "NOTE: project-version gate skipped"] |
|
lappend result gateabort [has $out "-aborted- (project-version"] |
|
set result |
|
}\ |
|
-result {timedout 0 note 1 gateabort 0} |
|
|
|
#fixture dirs are makeDirectory-registered; pre-delete defensively with catch |
|
#(git object files are read-only on windows) so cleanupTests has nothing left |
|
#to trip on |
|
variable fixgit |
|
variable fixnogit |
|
if {$fixgit ne ""} {catch {file delete -force $fixgit}} |
|
if {$fixnogit ne ""} {catch {file delete -force $fixnogit}} |
|
|
|
cleanupTests |
|
} |
|
namespace delete ::testspace
|
|
|