Browse Source
src/make.tcl kit icon seam (G-057): mechanism selection is now punkres-first - kiticon::punkres_available (memoized; binary presence at bin/punkres(.exe) is the selection signal) + kit_icon_embed_punkres (exec wrapper; punkres verifies its own output). twapi arm unchanged as fallback; when NEITHER serves the skip notice combines both reasons and names the 'make.tcl tool build punkres' remedy. Sidecar embedding value gains 'punkres' (bin/AGENTS.md format doc, ARCHITECTURE.md kit-icon bullet updated; architecture_lint clean). Live-bake fallback matrix on punkluck86 (win32-ix86 = PE32 arm live): punkres present -> embedded via punkres, kit boots + smoke OK; punkres absent + twapi loadable -> via twapi; both absent -> unavailable with combined notice, embedding none (exact pre-G-128 degradation). Live parity: both arms' baked kits listing-identical (codepage host-ACP noise finding recorded in the goal detail) with byte-identical extracted icons. New src/tests/shell/testsuites/punkexe/punkres.test (7/7 under the tclsh9.0.5-punk runner; self-gates on bin/punkres + store fixture): overlay- unsafe refusal exit 3 with untouched input, consented file-relative shift with convention preserved, payload intact via punk::zip members + crc-verified extraction, icon replaced (extract-ico == punkshell.ico), idempotent re-stamp byte-identical, make.tcl tool info punkres provenance records. Full punkexe suite 83 tests 0 failed (no collateral). Goal detail: Notes findings (codepage noise, root-vendorlib twapi fragility, nested tclsfe payload, metakit move-safety -> G-101 pointer updated) + Progress increment 1 with the two remaining acceptance items (non-windows-host e2e, punkbin publication route) and one acceptance-wording flag for the user (metakit 'kit' shape vs 'zip overlay' clause). punkshell 0.30.1 + CHANGELOG. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
7 changed files with 452 additions and 32 deletions
@ -1,4 +1,4 @@
|
||||
[project] |
||||
name = "punkshell" |
||||
version = "0.30.0" |
||||
version = "0.30.1" |
||||
license = "BSD-2-Clause" |
||||
|
||||
@ -0,0 +1,234 @@
|
||||
package require tcltest |
||||
|
||||
#Characterization of the vendored punkres portable PE resource stamper (goal |
||||
#G-128) against a REAL artifact: the file-relative prefixed runtime |
||||
#bin/runtime/win32-x86_64/tclsh90b4_piperepl.exe (the same store fixture the |
||||
#punk::zip accelerator parity suite uses). Pins the G-128 acceptance behaviours |
||||
#on scratch COPIES (store originals are never modified): |
||||
# - overlay-unsafe refusal: a file-relative zip payload is REFUSED by default |
||||
# (exit 3) with the reason and both remedies named |
||||
# - consented stamp: -allow-file-relative-shift stamps, the offset convention |
||||
# is PRESERVED (punk::zip::archive_info offsetstyle still 'file'), the |
||||
# member count is unchanged and member data crc-verifies (payload intact) |
||||
# - icon replaced: extract-ico of the stamped copy is byte-identical to |
||||
# src/runtime/punkshell.ico |
||||
# - idempotent: re-stamping the stamped copy is byte-identical (convergence) |
||||
# - make.tcl tool discovery: 'tool info punkres' reports the PROVENANCE.md |
||||
# records (run via the punk executable's script subcommand, as |
||||
# maketcltool.test does for punkzip) |
||||
#All punkres tests self-gate on bin/punkres(.exe) being built (zig stays |
||||
#OPTIONAL - an unbuilt tree skips them) and on the store fixture being present. |
||||
# |
||||
#Target punk executable for the make.tcl test resolved from |
||||
#env(PUNK_SHELL_TEST_EXE), else <projectroot>/bin/punk902z.exe then |
||||
#<projectroot>/bin/punkshell902. |
||||
|
||||
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 punkresexe "" |
||||
foreach candidate [list [file join $projectroot bin punkres.exe] [file join $projectroot bin punkres]] { |
||||
if {[file isfile $candidate]} { |
||||
set punkresexe $candidate |
||||
break |
||||
} |
||||
} |
||||
variable fixture [file join $projectroot bin runtime win32-x86_64 tclsh90b4_piperepl.exe] |
||||
variable srcicon [file join $projectroot src runtime punkshell.ico] |
||||
|
||||
testConstraint punkresavailable [expr {$punkresexe ne ""}] |
||||
testConstraint punkresfixture [expr {$punkresexe ne "" && [file isfile $fixture] && [file isfile $srcicon]}] |
||||
testConstraint punkzipmodule [expr {![catch {package require punk::zip}]}] |
||||
|
||||
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]}] |
||||
|
||||
#run punkres with stderr merged; returns {exitcode output}. exec raises on |
||||
#nonzero exit with CHILDSTATUS carrying the code. |
||||
proc run_punkres {args} { |
||||
variable punkresexe |
||||
set rc 0 |
||||
set out "" |
||||
if {[catch {exec [file nativename $punkresexe] {*}$args 2>@1} out errdict]} { |
||||
if {[lindex [dict get $errdict -errorcode] 0] eq "CHILDSTATUS"} { |
||||
set rc [lindex [dict get $errdict -errorcode] end] |
||||
} else { |
||||
set rc -1 |
||||
} |
||||
} |
||||
return [list $rc $out] |
||||
} |
||||
|
||||
proc readbin {path} { |
||||
set f [open $path rb] |
||||
set data [read $f] |
||||
close $f |
||||
return $data |
||||
} |
||||
|
||||
variable workdir [temporaryDirectory] |
||||
variable frcopy [file join $workdir punkres_frcopy.exe] |
||||
variable frcopy2 [file join $workdir punkres_frcopy2.exe] |
||||
variable exico [file join $workdir punkres_extracted.ico] |
||||
|
||||
#added 2026-07-29 (agent, G-128) |
||||
test punkres_info_fixture {info -porcelain classifies the store piperepl runtime: zip payload, file-relative offsets} -constraints {punkresfixture} -body { |
||||
variable fixture |
||||
lassign [run_punkres info -porcelain [file nativename $fixture]] rc out |
||||
set result [list rc $rc] |
||||
lappend result versionline [regexp {(?n)^punkres_info_v1$} $out] |
||||
lappend result kind [regexp {(?n)^overlay_kind zip$} $out] |
||||
lappend result style [regexp {(?n)^zip_style file$} $out] |
||||
lappend result base0 [regexp {(?n)^zip_base 0$} $out] |
||||
lappend result members [regexp {(?n)^zip_members [1-9][0-9]*$} $out] |
||||
set result |
||||
} -result {rc 0 versionline 1 kind 1 style 1 base0 1 members 1} |
||||
|
||||
#added 2026-07-29 (agent, G-128) |
||||
test punkres_refuse_file_relative {set-icon on a file-relative payload copy is refused by default: exit 3, reason + both remedies} -constraints {punkresfixture} -body { |
||||
variable fixture; variable frcopy; variable srcicon |
||||
file copy -force $fixture $frcopy |
||||
lassign [run_punkres set-icon [file nativename $frcopy] [file nativename $srcicon]] rc out |
||||
set result [list rc $rc] |
||||
lappend result refused [regexp {REFUSED: appended zip payload records FILE-relative member offsets} $out] |
||||
lappend result remedyflag [regexp -- {-allow-file-relative-shift} $out] |
||||
lappend result remedyrewrap [regexp {rewrap the artifact archive-relative} $out] |
||||
#refusal happened before any write: the copy is untouched |
||||
lappend result untouched [string equal [readbin $frcopy] [readbin $fixture]] |
||||
set result |
||||
} -result {rc 3 refused 1 remedyflag 1 remedyrewrap 1 untouched 1} |
||||
|
||||
#added 2026-07-29 (agent, G-128) |
||||
test punkres_consent_shift {consented stamp preserves the file-relative convention with all offsets rewritten} -constraints {punkresfixture} -body { |
||||
variable frcopy; variable srcicon |
||||
lassign [run_punkres set-icon -allow-file-relative-shift [file nativename $frcopy] [file nativename $srcicon]] rc out |
||||
set result [list rc $rc] |
||||
lappend result moved [regexp {overlay: zip file-relative, [0-9]+ bytes moved by [0-9]+; [0-9]+ central-directory offsets and the EOCD directory offset rewritten \(non-standard convention PRESERVED\)} $out] |
||||
lappend result verified [regexp {verify: resources re-read OK; zip overlay file-relative preserved, [0-9]+ members, all local headers at rewritten offsets} $out] |
||||
set result |
||||
} -result {rc 0 moved 1 verified 1} |
||||
|
||||
#added 2026-07-29 (agent, G-128) |
||||
test punkres_payload_intact {stamped copy's payload: offsetstyle still file, member count unchanged, member data crc-verifies} -constraints {punkresfixture punkzipmodule} -body { |
||||
variable fixture; variable frcopy; variable workdir |
||||
set orig_info [punk::zip::archive_info $fixture] |
||||
set new_info [punk::zip::archive_info $frcopy] |
||||
set result [list] |
||||
lappend result offsetstyle [dict get $new_info offsetstyle] |
||||
lappend result members_match [expr {[llength [punk::zip::members $frcopy]] == [llength [punk::zip::members $fixture]]}] |
||||
#crc-verified extraction of a member subset proves data intact through |
||||
#the shift (-verify defaults to 1: a crc mismatch raises) |
||||
set exdir [file join $workdir punkres_exdir] |
||||
file delete -force $exdir |
||||
file mkdir $exdir |
||||
punk::zip::unzip $frcopy $exdir tcl_library/init.tcl |
||||
lappend result extracted [file isfile [file join $exdir tcl_library init.tcl]] |
||||
file delete -force $exdir |
||||
set result |
||||
} -result {offsetstyle file members_match 1 extracted 1} |
||||
|
||||
#added 2026-07-29 (agent, G-128) |
||||
test punkres_icon_replaced {extract-ico of the stamped copy is byte-identical to the source punkshell.ico} -constraints {punkresfixture} -body { |
||||
variable frcopy; variable exico; variable srcicon |
||||
file delete -force $exico |
||||
lassign [run_punkres extract-ico [file nativename $frcopy] [file nativename $exico]] rc out |
||||
set result [list rc $rc] |
||||
lappend result identical [string equal [readbin $exico] [readbin $srcicon]] |
||||
set result |
||||
} -cleanup { |
||||
file delete -force $exico |
||||
} -result {rc 0 identical 1} |
||||
|
||||
#added 2026-07-29 (agent, G-128) |
||||
test punkres_idempotent {re-stamping the stamped copy converges byte-identically (rebuild mode, no accumulation)} -constraints {punkresfixture} -body { |
||||
variable frcopy; variable frcopy2; variable srcicon |
||||
lassign [run_punkres set-icon -o [file nativename $frcopy2] -allow-file-relative-shift [file nativename $frcopy] [file nativename $srcicon]] rc out |
||||
set result [list rc $rc] |
||||
lappend result rebuildmode [regexp {mode: rebuild section \.prsrc in place} $out] |
||||
lappend result identical [string equal [readbin $frcopy] [readbin $frcopy2]] |
||||
set result |
||||
} -cleanup { |
||||
file delete -force $frcopy $frcopy2 |
||||
} -result {rc 0 rebuildmode 1 identical 1} |
||||
|
||||
# -- make.tcl tool discovery (same piped pattern as maketcltool.test) -- |
||||
|
||||
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 |
||||
} |
||||
} |
||||
|
||||
proc maketcl_run {cmdargs} { |
||||
variable runstate |
||||
variable maketcl_run_timeout_ms |
||||
variable punkexe |
||||
variable maketcl |
||||
array unset runstate |
||||
set runstate(output) "" |
||||
set runstate(done) "" |
||||
|
||||
set chan [open |[list $punkexe script $maketcl {*}$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)] |
||||
} |
||||
|
||||
#added 2026-07-29 (agent, G-128) |
||||
test maketcl_tool_info_punkres {tool info punkres reports the PROVENANCE.md records (zero-edit discovery of the second tool)} -constraints {punkexeavailable} -body { |
||||
set r [maketcl_run {tool info punkres}] |
||||
set out [dict get $r output] |
||||
set result [list] |
||||
lappend result timedout [dict get $r timedout] exitcode [dict get $r exitcode] |
||||
lappend result toolline [regexp {(?n)^tool: punkres\s*$} $out] |
||||
lappend result upstream [regexp {(?n)^ upstream:\s+\S+} $out] |
||||
lappend result commit [regexp {(?n)^ vendored commit: [0-9a-f]{40}\s*$} $out] |
||||
lappend result provfile [regexp {(?n)^ provenance:\s+\S+PROVENANCE\.md\s*$} $out] |
||||
lappend result floor [regexp {(?n)^ zig floor:\s+>= 0\.16\.0\s*$} $out] |
||||
set result |
||||
} -result {timedout 0 exitcode 0 toolline 1 upstream 1 commit 1 provfile 1 floor 1} |
||||
|
||||
cleanupTests |
||||
} |
||||
namespace delete ::testspace |
||||
Loading…
Reference in new issue