Browse Source
Boot (punk_main.tcl + project_main.tcl, identical copies):
- zipfs presence keys on tcl::zipfs::mount - present in every supported zipfs
generation - not tcl::zipfs::root (8.7/9-era; absent from the androwish/
undroidwish 8.6 backport, whose ::zipfs ensemble also lacks a root subcommand).
- New factored ::punkboot procs (zipfs_mount_pairs, zipfs_kit_mountbase,
path_within) derive where this executable's attached archive actually mounted:
the mount-table entry whose archive file is [info nameofexecutable] (the
backport reports it without the windows drive prefix - handled), fallback the
mount containing the boot script. //zipfs:/app stays the expected modern
answer, not an assumption. Procs remain defined post-boot for tests.
- A mounted archive that cannot be attributed to the executable is reported on
stderr instead of silently configuring no internal paths (the old failure shape).
- The starkit quick-search line [zipfs root]/app/tcl_library (an error on the
backport) uses the derived base; internal_paths gains the derived base when no
zipfs volume root covers it; the internal-only simulate-kit branch recognises a
script under the derived mount as kit-internal.
make.tcl (necessary companion fixes - Scope extension flagged in the goal file):
- Runtime capability probe keys has_zipfs on tcl::zipfs::mount (was root, which
refused zip assembly for the backport; the block also rode a body-less
'if {![catch ..]}' that only worked because piped-stdin tclsh continues past
command errors).
- merge_over resolves relative fauxlink targets against the link file's own
directory (the fauxlink module's symlink semantics) - identical for the
pre-existing root-level links, required for the new nested one.
Payload + matrix:
- punk8win.vfs gains an app/main.tcl fauxlink beside root main.tcl: the
undroidwish family auto-runs app/main.tcl INSIDE the attached archive
(embedded /app/main.tcl string in the exe) and ignores a root main.tcl.
Inert in the metakit kits sharing the payload (punksys/punk86/punkbi verified).
- mapvfs.config: punkluck86 (tclsh8.6.10-luck-zip) + punk91ix86
(tclsh9.1b0-tclsfe), both zip kits targeting win32-ix86.
Tests + docs:
- New shell/testsuites/punkexe/kitmountpoint.test (4 tests): backport exe-path
attribution, modern-32 //zipfs:/app, baked punkexe regression pin,
unattributed-mount stderr report + no foreign paths. Self-gates on the
untracked verification runtimes.
- bin/AGENTS.md "Kit-wrappable runtime requirements (G-129)" + src/AGENTS.md
pointer, src/vfs/AGENTS.md boot contract, src/tests/shell/AGENTS.md suite doc,
ARCHITECTURE.md boot-chain bullet.
- Thin-layout + templates-modpod copies synced (make.tcl modules; _config boot
mains refreshed into the project-0.1 store layout per the 17250a8c precedent).
Verified: punkluck86 + punk91ix86 boot and resolve punk::args from inside their
mounts with externals stripped; punk905/punk902z (zipfs) + punksys/punk86
(starkit) probe byte-identical before/after; both zip offset conventions (mkimg
+ concat) mount on the backport; full suite 1171 tests with only the documented
exec-14.3 baseline failure.
Claude-Session: https://claude.ai/code/session_01UEgomWq6kA6c4A8GswqqGW
Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
20 changed files with 1300 additions and 177 deletions
@ -1,4 +1,4 @@
|
||||
[project] |
||||
name = "punkshell" |
||||
version = "0.27.4" |
||||
version = "0.28.0" |
||||
license = "BSD-2-Clause" |
||||
|
||||
@ -0,0 +1,264 @@
|
||||
package require tcltest |
||||
|
||||
#added 2026-07-27 (agent, G-129) |
||||
#G-129 characterization: the kit boot derives its payload mount point from the runtime's |
||||
#own zipfs mount table (the entry whose archive file is [info nameofexecutable]) instead |
||||
#of assuming tcl::zipfs::root + //zipfs:/app - so a runtime that mounts its attached |
||||
#archive at the EXECUTABLE'S OWN PATH (the androwish/undroidwish 8.6 backport family, |
||||
#which also has no tcl::zipfs::root) boots a kit that finds its own modules and libs. |
||||
# |
||||
#The runtime-driven tests exercise the WORKING TREE's src/vfs/_config/punk_main.tcl |
||||
#directly (runtime + punk_main.tcl as its script argument + 'tclsh <probe>' args), so no |
||||
#bake is needed and no stale-kit caveat applies. The derivation is asserted through |
||||
#::punkboot::zipfs_kit_mountbase, which punk_main.tcl leaves defined after boot. |
||||
# |
||||
#Self-gating (the pattern zipreader_piperepl_runtime uses): the two third-party 32-bit |
||||
#verification runtimes live in the untracked bin/runtime/win32-ix86/ store tier - tests |
||||
#skip cleanly when they are absent. The LUCK build is reproducible from the service named |
||||
#in bin/runtime/win32-ix86/LUCK.url via the base64 build request in |
||||
#tclsh8.6.10-luck-zip.cfg; tclsh9.1b0-tclsfe.exe comes from apnadkarni/tcl-sfe releases. |
||||
#The punkexe-kit test asserts the BAKED main.tcl and gates on the derivation proc being |
||||
#present in the kit (a pre-G-129 kit skips; rebuild per this suite's AGENTS.md notes). |
||||
#The unattributed-mount test uses any zipfs-capable runtime with an EMPTY mount table |
||||
#(default bin/runtime/win32-x86_64/tclkit902.exe - metakit payload, tcl9 core zipfs). |
||||
|
||||
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 punkmain $projectroot/src/vfs/_config/punk_main.tcl |
||||
|
||||
variable luckexe $projectroot/bin/runtime/win32-ix86/tclsh8.6.10-luck-zip.exe |
||||
variable sfe32exe $projectroot/bin/runtime/win32-ix86/tclsh9.1b0-tclsfe.exe |
||||
variable emptymountexe $projectroot/bin/runtime/win32-x86_64/tclkit902.exe |
||||
|
||||
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 |
||||
} |
||||
} |
||||
} |
||||
|
||||
variable punk_run_timeout_ms 30000 |
||||
variable runstate |
||||
array set runstate {} |
||||
|
||||
proc punk_run_read {chan} { |
||||
variable runstate |
||||
append runstate(output) [read $chan] |
||||
if {[chan eof $chan]} { |
||||
chan event $chan readable {} |
||||
set runstate(done) eof |
||||
} |
||||
} |
||||
#Run an executable with args, feed stdin_data via pipe then half-close. |
||||
#Returns dict: timedout 0|1, exitcode <int|kill-info|"">, output <combined stdout+stderr> |
||||
proc punk_run {exe cmdargs stdin_data} { |
||||
variable runstate |
||||
variable punk_run_timeout_ms |
||||
array unset runstate |
||||
set runstate(output) "" |
||||
set runstate(done) "" |
||||
set env_had [info exists ::env(PUNK_PIPE_EOF)] |
||||
if {$env_had} { |
||||
set env_save $::env(PUNK_PIPE_EOF) |
||||
} |
||||
set ::env(PUNK_PIPE_EOF) exit |
||||
set chan [open |[list $exe {*}$cmdargs 2>@1] r+] |
||||
if {$env_had} { |
||||
set ::env(PUNK_PIPE_EOF) $env_save |
||||
} else { |
||||
unset ::env(PUNK_PIPE_EOF) |
||||
} |
||||
set pids [pid $chan] |
||||
chan configure $chan -blocking 0 -translation binary |
||||
catch { |
||||
puts -nonewline $chan $stdin_data |
||||
flush $chan |
||||
chan close $chan write |
||||
} |
||||
set timerid [after $punk_run_timeout_ms [list set [namespace current]::runstate(done) timeout]] |
||||
chan event $chan readable [list [namespace current]::punk_run_read $chan] |
||||
vwait [namespace current]::runstate(done) |
||||
after cancel $timerid |
||||
set timedout [expr {$runstate(done) eq "timeout"}] |
||||
set exitcode "" |
||||
if {$timedout} { |
||||
foreach p $pids { |
||||
catch {exec {*}[auto_execok taskkill] /F /T /PID $p} killres |
||||
lappend exitcode [list killed $p] |
||||
} |
||||
catch {chan close $chan} |
||||
} else { |
||||
chan configure $chan -blocking 1 |
||||
if {[catch {chan close $chan} errM errOpts]} { |
||||
set details [dict get $errOpts -errorcode] |
||||
if {[lindex $details 0] eq "CHILDSTATUS"} { |
||||
set exitcode [lindex $details 2] |
||||
} else { |
||||
set exitcode [list error $errM] |
||||
} |
||||
} else { |
||||
set exitcode 0 |
||||
} |
||||
} |
||||
return [dict create timedout $timedout exitcode $exitcode output $runstate(output)] |
||||
} |
||||
|
||||
#shared probe: runs under '<runtime> punk_main.tcl tclsh <probe>' AFTER the boot path |
||||
#assembly - reports the derivation's answer and whether it equals this executable's path |
||||
variable mountprobe [makeFile { |
||||
set mb [::punkboot::zipfs_kit_mountbase] |
||||
set normexe [file dirname [file normalize [file join [info nameofexecutable] __dummy__]]] |
||||
puts "MOUNTBASE=>$mb<" |
||||
puts "MOUNTBASE_IS_EXEPATH=[string equal -nocase $mb $normexe]" |
||||
exit 0 |
||||
} kitmountpoint_probe.tcl] |
||||
variable mountprobe_fwd [string map {\\ /} $mountprobe] |
||||
|
||||
testConstraint windowshost [expr {$::tcl_platform(platform) eq "windows"}] |
||||
testConstraint luckruntime [expr {$::tcl_platform(platform) eq "windows" && [file exists $luckexe]}] |
||||
testConstraint sfe32runtime [expr {$::tcl_platform(platform) eq "windows" && [file exists $sfe32exe]}] |
||||
|
||||
#punkexe kit gate: kit exists AND its baked main.tcl defines the derivation proc |
||||
#(a kit baked before G-129 skips rather than fails) |
||||
variable punkexe_has_derivation 0 |
||||
if {$punkexe ne "" && [file exists $punkexe]} { |
||||
variable gateprobe [makeFile { |
||||
puts "HASDERIVATION=[expr {[info commands ::punkboot::zipfs_kit_mountbase] ne ""}]" |
||||
exit 0 |
||||
} kitmountpoint_gate.tcl] |
||||
set r [punk_run $punkexe [list tclsh [string map {\\ /} $gateprobe]] ""] |
||||
if {![dict get $r timedout] && [string match "*HASDERIVATION=1*" [dict get $r output]]} { |
||||
set punkexe_has_derivation 1 |
||||
} |
||||
} |
||||
testConstraint punkexederivation $punkexe_has_derivation |
||||
|
||||
#empty-mount-table runtime gate for the unattributed-mount test: zipfs commands |
||||
#present (incl mkzip) but nothing mounted (library carried outside zipfs) |
||||
variable emptymount_ok 0 |
||||
if {[file exists $emptymountexe]} { |
||||
variable emptyprobe [makeFile { |
||||
set ok [expr {[info commands ::tcl::zipfs::mount] ne "" && [info commands ::tcl::zipfs::mkzip] ne "" && ![llength [::tcl::zipfs::mount]]}] |
||||
puts "EMPTYMOUNTOK=$ok" |
||||
exit 0 |
||||
} kitmountpoint_emptygate.tcl] |
||||
set r [punk_run $emptymountexe [list [string map {\\ /} $emptyprobe]] ""] |
||||
if {![dict get $r timedout] && [string match "*EMPTYMOUNTOK=1*" [dict get $r output]]} { |
||||
set emptymount_ok 1 |
||||
} |
||||
} |
||||
testConstraint emptymountruntime $emptymount_ok |
||||
|
||||
test kitmountpoint_backport_exe_mount {8.6 backport family (no tcl::zipfs::root, archive mounted at the executable's own path): the boot attributes the mount to the executable and reports it as the mount base}\ |
||||
-constraints luckruntime\ |
||||
-setup { |
||||
set result "" |
||||
}\ |
||||
-body { |
||||
variable luckexe |
||||
variable punkmain |
||||
variable mountprobe_fwd |
||||
set r [punk_run $luckexe [list [string map {\\ /} $punkmain] tclsh $mountprobe_fwd] ""] |
||||
lappend result [dict get $r timedout] |
||||
lappend result [regexp {MOUNTBASE_IS_EXEPATH=1} [dict get $r output]] |
||||
lappend result [string match "*none of the mounts could be attributed*" [dict get $r output]] |
||||
set result |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list 0 1 0] |
||||
|
||||
test kitmountpoint_modern32_app_mount {modern //zipfs:/app convention (32-bit tcl-sfe): the derivation returns the conventional mount - the 32-bit target itself needs nothing special}\ |
||||
-constraints sfe32runtime\ |
||||
-setup { |
||||
set result "" |
||||
}\ |
||||
-body { |
||||
variable sfe32exe |
||||
variable punkmain |
||||
variable mountprobe_fwd |
||||
set r [punk_run $sfe32exe [list [string map {\\ /} $punkmain] tclsh $mountprobe_fwd] ""] |
||||
lappend result [dict get $r timedout] |
||||
lappend result [regexp {MOUNTBASE=>//zipfs:/app<} [dict get $r output]] |
||||
lappend result [string match "*none of the mounts could be attributed*" [dict get $r output]] |
||||
set result |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list 0 1 0] |
||||
|
||||
test kitmountpoint_punkexe_app_mount {the ordinary 64-bit zipfs kit still derives //zipfs:/app (baked main.tcl - regression pin for the modern case)}\ |
||||
-constraints punkexederivation\ |
||||
-setup { |
||||
set result "" |
||||
}\ |
||||
-body { |
||||
variable punkexe |
||||
variable mountprobe_fwd |
||||
set r [punk_run $punkexe [list tclsh $mountprobe_fwd] ""] |
||||
lappend result [dict get $r timedout] |
||||
lappend result [regexp {MOUNTBASE=>//zipfs:/app<} [dict get $r output]] |
||||
set result |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list 0 1] |
||||
|
||||
test kitmountpoint_unattributed_reports_stderr {a mounted zipfs archive that cannot be attributed to the executable is reported on stderr (not silent), boot continues, and the foreign mount contributes no kit paths}\ |
||||
-constraints emptymountruntime\ |
||||
-setup { |
||||
set result "" |
||||
#wrapper: mount a freshly built unrelated zip (no exe-attributable entry in the |
||||
#table), then source the working tree's punk_main.tcl dispatching a post-boot probe |
||||
variable postprobe [makeFile { |
||||
puts "POSTTM=>[tcl::tm::list]<" |
||||
puts "POSTAP=>$::auto_path<" |
||||
puts "POSTBOOT_OK" |
||||
exit 0 |
||||
} kitmountpoint_post.tcl] |
||||
variable wrapper [makeFile [string map [list %PUNKMAIN% [string map {\\ /} $punkmain] %POSTPROBE% [string map {\\ /} $postprobe]] { |
||||
set tmpbase [file dirname [info script]] |
||||
file mkdir $tmpbase/g129dummydir |
||||
set fd [open $tmpbase/g129dummydir/marker.txt w] |
||||
puts $fd g129 |
||||
close $fd |
||||
tcl::zipfs::mkzip $tmpbase/g129dummy.zip $tmpbase/g129dummydir $tmpbase/g129dummydir |
||||
#tcl 9 core order is 'zipfs mount zipfile mountpoint'; accept the reversed |
||||
#order used by some generations |
||||
if {[catch {tcl::zipfs::mount $tmpbase/g129dummy.zip //zipfs:/g129test}]} { |
||||
tcl::zipfs::mount //zipfs:/g129test $tmpbase/g129dummy.zip |
||||
} |
||||
set ::argv [list tclsh %POSTPROBE%] |
||||
source %PUNKMAIN% |
||||
}] kitmountpoint_wrapper.tcl] |
||||
}\ |
||||
-body { |
||||
variable emptymountexe |
||||
variable wrapper |
||||
set r [punk_run $emptymountexe [list [string map {\\ /} $wrapper]] ""] |
||||
set out [dict get $r output] |
||||
lappend result [dict get $r timedout] |
||||
lappend result [string match "*none of the mounts could be attributed*" $out] |
||||
lappend result [string match "*POSTBOOT_OK*" $out] |
||||
set tm_and_ap "" |
||||
regexp {POSTTM=>([^<]*)<} $out -> tm_part |
||||
regexp {POSTAP=>([^<]*)<} $out -> ap_part |
||||
if {[info exists tm_part]} {append tm_and_ap $tm_part} |
||||
if {[info exists ap_part]} {append tm_and_ap " " $ap_part} |
||||
lappend result [string match "*g129test*" $tm_and_ap] |
||||
set result |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list 0 1 1 0] |
||||
} |
||||
tcltest::cleanupTests ;#needed to produce test summary line. |
||||
Loading…
Reference in new issue