diff --git a/CHANGELOG.md b/CHANGELOG.md index 4193d909..60f0e055 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,20 @@ The latest `## [X.Y.Z]` header must match the `version` field in `punkproject.to Entries are newest-first; one bullet per notable change. See the root `AGENTS.md` "Project Versioning" section for the bump policy. +## [0.47.2] - 2026-08-03 + +- modpod 0.1.6 (G-111 tidy): the broken tar-era connection API is removed + (connect/disconnect/get and their system:: helpers - dead since the tarjar + era, no callers), is_valid_tm_version fixed, make_mountable_zip debug + output removed (-offsettype file no longer errors under the module's + declared dependencies), struct::set dependency dropped, and the load stub + gains the unwrapped #modpod-- redirect: an extracted folder + beside the .tm is sourced directly - loads with neither zipfs nor vfs::zip + available. First modpod testsuite added (src/tests/modules/modpod/) + covering wrap/load round-trips including a probed binary payload; green on + the tcl9 kit and native tclsh90 (7/7) and punk86 8.6 (6/7 - the + zipfs-container test skips on 8.6, recorded per G-034). + ## [0.47.1] - 2026-08-02 - Boot core 0.2.1: the built-in subcommands that require app packages diff --git a/GOALS.md b/GOALS.md index 8bc72a23..a5be0ff8 100644 --- a/GOALS.md +++ b/GOALS.md @@ -337,8 +337,8 @@ Detail: goals/G-109-libunknown-manifest-multiname-tm.md Scope: investigation + decision record (goals/G-110-sharedlib-extraction-cache.md); prototype surface: punk/modpod-side loaders (modpod stub, punk boot loading - no core change required); src/buildsuites/suite_tcl90/patches/ (candidate zipfs-load core patch if adopted); TIP 741/709 relationship record Detail: goals/G-110-sharedlib-extraction-cache.md -### G-111 [proposed] modpod tidy: fix/remove tar-era remnants + first test baseline -Scope: modpod canonical source (c:/repo/jn/tclmodules/modpod fossil checkout, src/modules/modpod-999999.0a1.0.tm) with re-vendor into shellspy (src/vendormodules/modpod-0.1.5.tm + bootsupport copies via established channels); punkshell-side tarjar artifacts ASSESSED ONLY (cli #tarjar-* module-type branch, libunknown skip-globs, vendored tarjar-2.4.3.tm, src/modules/_build/#tarjar-tarjar-2.3 - dispositions individually user-confirmed, preservation-aware per the c:/tclmodules/main manual-migration intent); new modpod testsuite (home settled in the work; shellspy src/tests/modules/ harness is the natural fit) +### G-111 [active] modpod tidy: fix/remove tar-era remnants + first test baseline +Scope: modpod canonical source (c:/repo/jn/tclmodules/modpod fossil checkout, src/modules/modpod-999999.0a1.0.tm) with re-vendor into shellspy (src/vendormodules/modpod-*.tm + bootsupport copies via established channels); punkshell-side tarjar artifacts ASSESSED ONLY (cli #tarjar-* module-type branch, libunknown skip-globs, vendored tarjar-2.4.3.tm, src/modules/_build/#tarjar-tarjar-2.3 - dispositions individually user-confirmed, preservation-aware per the c:/tclmodules/main manual-migration intent); new modpod testsuite (home settled in the work; shellspy src/tests/modules/ harness is the natural fit) Detail: goals/G-111-modpod-tidy-tests.md ### G-114 [proposed] Per-platform tm module roots: platform-segregated binary .tm via tcl::tm::path diff --git a/goals/G-111-modpod-tidy-tests.md b/goals/G-111-modpod-tidy-tests.md index 189afa3a..29449361 100644 --- a/goals/G-111-modpod-tidy-tests.md +++ b/goals/G-111-modpod-tidy-tests.md @@ -1,7 +1,7 @@ # G-111 modpod tidy: fix/remove tar-era remnants + first test baseline -Status: proposed -Scope: modpod canonical source (c:/repo/jn/tclmodules/modpod fossil checkout, src/modules/modpod-999999.0a1.0.tm) with re-vendor into shellspy (src/vendormodules/modpod-0.1.5.tm + bootsupport copies via established channels); punkshell-side tarjar artifacts ASSESSED ONLY (cli #tarjar-* module-type branch, libunknown skip-globs, vendored tarjar-2.4.3.tm, src/modules/_build/#tarjar-tarjar-2.3 - dispositions individually user-confirmed, preservation-aware per the c:/tclmodules/main manual-migration intent); new modpod testsuite (home settled in the work; shellspy src/tests/modules/ harness is the natural fit) +Status: active +Scope: modpod canonical source (c:/repo/jn/tclmodules/modpod fossil checkout, src/modules/modpod-999999.0a1.0.tm) with re-vendor into shellspy (src/vendormodules/modpod-*.tm + bootsupport copies via established channels); punkshell-side tarjar artifacts ASSESSED ONLY (cli #tarjar-* module-type branch, libunknown skip-globs, vendored tarjar-2.4.3.tm, src/modules/_build/#tarjar-tarjar-2.3 - dispositions individually user-confirmed, preservation-aware per the c:/tclmodules/main manual-migration intent); new modpod testsuite (home settled in the work; shellspy src/tests/modules/ harness is the natural fit) Goal: modpod's surviving zip-based surface is sound and tested: the tar-era broken/dead code inside the modpod module is fixed or removed with each item dispositioned, tarjar-SYSTEM artifacts elsewhere get user-confirmed preservation-aware dispositions only (old tarjar material at c:/tclmodules/main is preserved/migrated manually by the user, outside this goal), and modpod gains its first test baseline covering wrap and load round-trips including a binary payload. Acceptance: each enumerated tar-era defect in modpod-999999.0a1.0.tm is dispositioned with the outcome recorded here (undefined tar::readHeader connect path; ::tarjar::connected reference in myfullname; con/connected and versionpart/versionparts typos; the malformed set/lindex constructs; connect's debug stderr puts; get's unimplemented wrapped branch); after the pass a grep of the modpod module for tarjar returns nothing or only deliberate keeps recorded here; punkshell-side tarjar artifacts each carry a recorded keep/remove/migrate disposition explicitly confirmed by the user, with none deleted absent that confirmation; a modpod testsuite exists and passes on the tcl9 kit and on 8.6 (or the 8.6 limitation is recorded per G-034), covering make_zip_modpod wrap then package require from a real-disk module path and from a zipfs module path, a binary-payload load, the unwrapped #modpod-folder redirect form, and both -offsettype forms; the fixed module is re-vendored into shellspy with the suite passing there. @@ -68,6 +68,127 @@ publish consumers); G-110 (tarjar .TclSoCache prior art lives inside the vendored tarjar tm - preserve access to it); G-034 (8.6 mount path - the 8.6 leg of the testsuite). +## Progress + +2026-08-03 tidy pass landed in the canonical module (modpod checkout +src/modules/modpod-999999.0a1.0.tm, buildversion -> 0.1.6). Disposition per +enumerated defect: + +- connect's debug stderr puts (L102): REMOVED with connect. +- con/connected typo (L144) + its ~L170 compound ($con(package,$modpod)): + REMOVED with connect. +- malformed set constructs (L149-150, 3-arg set + value-less set): REMOVED + with connect. +- undefined tar::readHeader connect path (L194): REMOVED with connect. +- versionpart/versionparts typo (L294): FIXED in place - + is_valid_tm_version now catches a braced [package vcompare] of its real + argument; returns 1/0 correctly (verified both ways). +- connect_if_not misplaced brackets (L598): REMOVED - proc deleted (its only + caller was get). +- myfullname's $::tarjar::connected reference (L652): REMOVED - proc deleted, + and myname with it (both depended on the connect registry). +- get's unimplemented wrapped branch: REMOVED - proc deleted. +- tarjar-named comments/messages/placeholder (L632/647/650/659): REMOVED; + tilde token renamed <_modpod_tilde_placeholder_>. Post-pass grep of the + module for tarjar (case-insensitive): ZERO hits - no deliberate keeps. + +Whole-proc summary: connection API removed entirely (connect, disconnect, +get, system::connect_if_not, system::myname, system::myfullname) - zip +modpods are self-mounting and no caller of the registry exists anywhere in +shellspy or the modpod checkout (survey 2026-08-03: only modpod's own synced +copies and commented-out loadscript lines reference these names). + +Additional items dispositioned in the same pass (not in the drafted +inventory): + +- connected(to) init bug (literal string "list") + unused modpodscript / + connected(self) / loadables / sourceables variables: REMOVED with the + registry. +- make_mountable_zip debug output REMOVED: three stderr EOCD dumps, per-item + central-directory header dumps including `ansistring VIEW` (an undeclared + dependency - made -offsettype file ERROR under the module's declared deps), + duplicate mid-branch showdict, stray ::last_header global write. The + catch-wrapped end-of-run showdict report is retained unchanged. +- struct::set dependency DROPPED (only connect used it; the stub carries its + own inline intersect). +- myversion KEPT (standalone and working): dead `upvar ::modpod::connected` + and tar-era comment removed. Pre-existing limitation noted, out of scope: + its scan %[a-z] classes misparse package names containing digits or + underscores (e.g. win32_x86_64_tcl8). +- STUB ADDITION (required by this goal's acceptance, and promised by the + stub's own comments): unwrapped redirect - an extracted + #modpod-- folder (exact name-version match) beside the .tm is + sourced directly BEFORE any mount attempt, giving a zero-dependency load + path when neither zipfs nor vfs::zip is available (G-034-relevant). + +Smoke evidence (bin/punk91 src, tcl 9.1, 2026-08-03): wrap via +punk::zip::mkzip + make_zip_modpod then require -> zipfs mount load + data +read OK (archive offsets); unwrapped-redirect load with NO mount OK; +-offsettype file wrap + mount load OK; API surface checks (removed procs +gone, kept procs present) OK. + +2026-08-03 testsuite + re-vendor landed: + +- Suite: src/tests/modules/modpod/testsuites/modpod/roundtrip.test (the + module's first tests). Fixture pods generated per run (no committed + binaries); child processes of [info nameofexecutable] (kit 'script' + subcommand or plain script-file dispatch, probed script-form-first). + Covers: wrap emits stub+zip (\x1A separator, PK header), fixed + is_valid_tm_version both ways, require from real-disk module path + (archive offsets), -offsettype file form, unwrapped #modpod-folder + redirect (exact extracted path asserted, no #mounted-modpod- signature), + probe-discovered dll payload loading from the mounted pod in a fresh + child, and tm-on-zipfs-path (zip-in-zip container). +- Results: punk91 (tcl 9.1 kit) 7/7 PASS; native tclsh90 (9.0.3) 7/7 PASS; + punk86 (8.6.17 kit) 6 pass / 1 skip / 0 fail - the skip is modpod-4.1 + (zipfs module path), gated on childzipfs: RECORDED LIMITATION per G-034 - + Tcl 8.6 has no zipfs, so the tm-inside-a-zip-container form needs it; + the disk-tm forms load via the stub's vfs::zip fallback (verified by the + passing 2.x tests) and the BINARY payload loads on 8.6 too (modpod-3.1 + PASS - tclvfs copy-to-temp load path). +- Re-vendor chain (established channels): modpod checkout mint via its own + make.tcl (tclsh90, modules/modpod-0.1.6.tm, 0.1.5 pruned; stamp-only diff + vs canonical verified) -> src/vendormodules/modpod-0.1.6.tm (0.1.5 + removed) -> make.tcl bootsupport (src/bootsupport/modules 0.1.6, 0.1.5 + pruned) -> make.tcl modules (root modules staging 0.1.6; the mint itself + exercised make_zip_modpod 0.1.6 over the repo's #modpod-* trees) -> + make.tcl vfscommonupdate (src/vfs/_vfscommon.vfs/modules 0.1.6) -> bake. +- Observation: runtests' own environment registers unwrapped #modpod-* + source trees via package ifneeded (runtestmodules.tcl boot lines) - the + harness itself consumes the unwrapped form. + +Remaining for acceptance: user-confirmed dispositions for the punkshell-side +tarjar artifacts (assessment + proposals below). + +### Tarjar-system artifact assessment (2026-08-03, proposals - awaiting user confirmation) + +Inventory verified on disk; VCS tracking checked in both git and fossil. +Nothing deleted. Proposed dispositions: + +1. src/vendormodules/tarjar-2.4.3.tm (TRACKED git+fossil; contains the + .TclSoCache prior art G-110 references): KEEP - the G-110 investigation + needs it accessible; migration to c:/tclmodules/main remains the user's + manual lane. +2. src/vendormodules/_aside/tarjar-2.3.tm (untracked, machine-local): + KEEP IN PLACE pending the user's manual preserve/migrate to + c:/tclmodules/main (per the tarjar preservation intent; no VCS presence + to tidy). +3. src/modules/_build/#tarjar-tarjar-2.3/ tree + _build/tarjar-2.3.tm + (untracked, machine-local; richest historical material - DESCRIPTION, + CHANGES, README.tarjar.txt, todo.txt, loadscript, codesnippets): + KEEP IN PLACE pending user-manual migrate to c:/tclmodules/main + (G-155, achieved - see goals/archive/G-155-mint-stage-vocabulary.md - + already records _build leftovers as deliberate). +4. punk::mix cli-999999.0a1.0.tm #tarjar-* build branch (~L1048-1300 + + tarjarglob plumbing): KEEP for now - dead in practice (the only + #tarjar-* dir on disk is under src/modules/_build, one level below the + scanned source dirs, so the branch never fires) but coupled to the + preservation question; removal is a cheap later tidy once the user's + migration completes. +5. punk::libunknown skip-globs for #modpod-*/#tarjar-*/_build + (libunknown-*.tm deep-scan filter): KEEP - the #modpod glob is required + regardless; the #tarjar glob is defensive and free. + ## Notes - 2026-07-21: drafted from the session findings and approved @@ -75,3 +196,10 @@ leg of the testsuite). - G-029 relationship (recorded 2026-07-24 after overlap review): its testmodpod generation exercises the same wrap+load round-trips this goal's baseline pins - the two suites share fixtures where sensible. +- 2026-08-03: ACTIVATED at user request. Activation-freshness overlap survey + re-run (goals_xref score G-111): existing refs (G-034/G-066/G-067/G-109/ + G-110/G-029) stand. Goals drafted since: Related: G-114 (per-platform tm + roots - its acceptance names a modpod demonstration artifact consuming the + wrap surface this goal pins). Related: G-156 (alpha-window census lists the + modpod repo in its fork/tool-repo lane - rename-window coordination only, + no code overlap). diff --git a/punkproject.toml b/punkproject.toml index db858773..cc22bee7 100644 --- a/punkproject.toml +++ b/punkproject.toml @@ -1,6 +1,6 @@ [project] name = "punkshell" -version = "0.47.1" +version = "0.47.2" license = "BSD-2-Clause" url = "https://www.gitea1.intx.com.au/jn/punkshell" #packager: declared identity for published artifacts (declarative, not proof - diff --git a/src/bootsupport/modules/modpod-0.1.5.tm b/src/bootsupport/modules/modpod-0.1.6.tm similarity index 59% rename from src/bootsupport/modules/modpod-0.1.5.tm rename to src/bootsupport/modules/modpod-0.1.6.tm index 63875951..e1f39a1a 100644 --- a/src/bootsupport/modules/modpod-0.1.5.tm +++ b/src/bootsupport/modules/modpod-0.1.6.tm @@ -7,7 +7,7 @@ # (C) 2024 # # @@ Meta Begin -# Application modpod 0.1.5 +# Application modpod 0.1.6 # Meta platform tcl # Meta license # @@ Meta End @@ -17,10 +17,10 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin modpod_module_modpod 0 0.1.5] +#[manpage_begin modpod_module_modpod 0 0.1.6] #[copyright "2024"] #[titledesc {Module API}] [comment {-- Name section and table of contents description --}] -#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] #[require modpod] #[keywords module] #[description] @@ -45,7 +45,6 @@ #[list_begin itemized] package require Tcl 8.6- -package require struct::set ;#review package require punk::lib package require punk::args #*** !doctools @@ -65,6 +64,15 @@ package require punk::args #changes +#0.1.6 - Remove connection API inherited from the earlier tar-based module system - connect, +# disconnect, get, system::connect_if_not, system::myname, system::myfullname - broken since that +# era, no callers. +# zip-based modpods are self-mounting via the stub emitted by modpod::lib::make_zip_modpod and need +# no connection registry. Stub gains unwrapped-folder redirect: an extracted #modpod-- +# folder beside the .tm is sourced directly (loads with neither zipfs nor vfs::zip available). +# Fix is_valid_tm_version (bad variable name made it always error). Remove debug output from +# make_mountable_zip (incl. undeclared ansistring dependency in the -offsettype file branch and +# stray ::last_header global). Drop struct::set dependency. #0.1.5 - Reduce pollution of global namespace with procs,variables #0.1.4 - when mounting with vfs::zip (because zipfs not available) - mount relative to executable folder instead of module dir # (given just a module name it's easier to find exepath than look at package ifneeded script to get module path) @@ -75,196 +83,14 @@ package require punk::args namespace eval modpod { namespace export {[a-z]*}; # Convention: export all lowercase - variable connected - if {![info exists connected(to)]} { - set connected(to) list - } - variable modpodscript - set modpodscript [info script] - if {[string tolower [file extension $modpodscript]] eq ".tcl"} { - set connected(self) [file dirname $modpodscript] - } else { - #expecting a .tm - set connected(self) $modpodscript - } - variable loadables [info sharedlibextension] - variable sourceables {.tcl .tk} ;# .tm ? + #zip-based modpods are self-mounting - the stub emitted by modpod::lib::make_zip_modpod requires + #no connection registry and no modpod package at load time. #*** !doctools #[subsection {Namespace modpod}] - #[para] Core API functions for modpod + #[para] Core API functions for modpod #[list_begin definitions] - - - #old tar connect mechanism - review - not needed? - proc connect {args} { - puts stderr "modpod::connect--->>$args" - set argd [punk::args::parse $args withdef { - @id -id ::modpod::connect - -type -default "" - @values -min 1 -max 1 - path -type string -minsize 1 -help "path to .tm file or toplevel .tcl script within #modpod-- folder (unwrapped modpod)" - }] - catch { - punk::lib::showdict $argd ;#heavy dependencies - } - set opt_path [dict get $argd values path] - variable connected - set original_connectpath $opt_path - set modpodpath [modpod::system::normalize $opt_path] ;# - - if {$modpodpath in $connected(to)} { - return [dict create ok ALREADY_CONNECTED] - } - lappend connected(to) $modpodpath - - set connected(connectpath,$opt_path) $original_connectpath - set is_sourced [expr {[file normalize $modpodpath] eq [file normalize [info script]]}] - - set connected(location,$modpodpath) [file dirname $modpodpath] - set connected(startdata,$modpodpath) -1 - set connected(type,$modpodpath) [dict get $argd opts -type] - set connected(fh,$modpodpath) "" - - if {[string range [file tail $modpodpath] 0 7] eq "#modpod-"} { - set connected(type,$modpodpath) "unwrapped" - lassign [::split [file tail [file dirname $modpodpath]] -] connected(package,$modpodpath) connected(version,$modpodpath) - set this_pkg_tm_folder [file dirname [file dirname $modpodpath]] - - } else { - #connect to .tm but may still be unwrapped version available - lassign [::split [file rootname [file tail $modpodpath]] -] connected(package,$modpodpath) connected(version,$modpodpath) - set this_pkg_tm_folder [file dirname $modpodpath] - if {$connected(type,$modpodpath) ne "unwrapped"} { - #Not directly connected to unwrapped version - but may still be redirected there - set unwrappedFolder [file join $connected(location,$modpodpath) #modpod-$connected(package,$modpodpath)-$connected(version,$modpodpath)] - if {[file exists $unwrappedFolder]} { - #folder with exact version-match must exist for redirect to 'unwrapped' - set con(type,$modpodpath) "modpod-redirecting" - } - } - - } - set unwrapped_tm_file [file join $this_pkg_tm_folder] "[set connected(package,$modpodpath)]-[set connected(version,$modpodpath)].tm" - set connected(tmfile,$modpodpath) - set tail_segments [list] - set lcase_tmfile_segments [string tolower [file split $this_pkg_tm_folder]] - set lcase_modulepaths [string tolower [tcl::tm::list]] - foreach lc_mpath $lcase_modulepaths { - set mpath_segments [file split $lc_mpath] - if {[llength [struct::set intersect $lcase_tmfile_segments $mpath_segments]] == [llength $mpath_segments]} { - set tail_segments [lrange [file split $this_pkg_tm_folder] [llength $mpath_segments] end] - break - } - } - if {[llength $tail_segments]} { - set connected(fullpackage,$modpodpath) [join [concat $tail_segments [set connected(package,$modpodpath)]] ::] ;#full name of package as used in package require - } else { - set connected(fullpackage,$modpodpath) [set connected(package,$modpodpath)] - } - - switch -exact -- $connected(type,$modpodpath) { - "modpod-redirecting" { - #redirect to the unwrapped version - set loadscript_name [file join $unwrappedFolder #modpod-loadscript-$con(package,$modpod).tcl] - - } - "unwrapped" { - if {[info commands ::thread::id] ne ""} { - set from [pid],[thread::id] - } else { - set from [pid] - } - #::modpod::Puts stderr "$from-> Package $connected(package,$modpodpath)-$connected(version,$modpodpath) is using unwrapped version: $modpodpath" - return [list ok ""] - } - default { - #autodetect .tm - zip/tar ? - #todo - use vfs ? - - #connect to tarball - start at 1st header - set connected(startdata,$modpodpath) 0 - set fh [open $modpodpath r] - set connected(fh,$modpodpath) $fh - fconfigure $fh -encoding iso8859-1 -translation binary -eofchar {} - - if {$connected(startdata,$modpodpath) >= 0} { - #verify we have a valid tar header - if {![catch {::modpod::system::tar::readHeader [read $fh 512]}]} { - seek $fh $connected(startdata,$modpodpath) start - return [list ok $fh] - } else { - #error "cannot verify tar header" - #try zipfs - if {[info commands tcl::zipfs::mount] ne ""} { - - } - } - } - lpop connected(to) end - set connected(startdata,$modpodpath) -1 - unset connected(fh,$modpodpath) - catch {close $fh} - return [dict create err {Does not appear to be a valid modpod}] - } - } - } - proc disconnect {{modpod ""}} { - variable connected - if {![llength $connected(to)]} { - return 0 - } - if {$modpod eq ""} { - puts stderr "modpod::disconnect WARNING: modpod not explicitly specified. Disconnecting last connected: [lindex $connected(to) end]" - set modpod [lindex $connected(to) end] - } - - if {[set posn [lsearch $connected(to) $modpod]] == -1} { - puts stderr "modpod::disconnect WARNING: disconnect called when not connected: $modpod" - return 0 - } - if {[string length $connected(fh,$modpod)]} { - close $connected(fh,$modpod) - } - array unset connected *,$modpod - set connected(to) [lreplace $connected(to) $posn $posn] - return 1 - } - proc get {args} { - set argd [punk::args::parse $args withdef { - @id -id ::modpod::get - -from -default "" -help "path to pod" - @values -min 1 -max 1 - filename - }] - set frompod [dict get $argd opts -from] - set filename [dict get $argd values filename] - - variable connected - #//review - set modpod [::modpod::system::connect_if_not $frompod] - set fh $connected(fh,$modpod) - if {$connected(type,$modpod) eq "unwrapped"} { - #for unwrapped connection - $connected(location) already points to the #modpod-pkg-ver folder - if {[string range $filename 0 0 eq "/"]} { - #absolute path (?) - set path [file join $connected(location,$modpod) .. [string trim $filename /]] - } else { - #relative path - use #modpod-xxx as base - set path [file join $connected(location,$modpod) $filename] - } - set fd [open $path r] - #utf-8? - #fconfigure $fd -encoding iso8859-1 -translation binary - return [list ok [lindex [list [read $fd] [close $fd]] 0]] - } else { - #read from vfs - puts stderr "get $filename from wrapped pod '$frompod' not implemented" - } - } - - #*** !doctools #[list_end] [comment {--- end definitions namespace modpod ---}] } @@ -279,19 +105,19 @@ namespace eval modpod::lib { namespace path [namespace parent] #*** !doctools #[subsection {Namespace modpod::lib}] - #[para] Secondary functions that are part of the API + #[para] Secondary functions that are part of the API #[list_begin definitions] #proc utility1 {p1 args} { # #*** !doctools # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] - # #[para]Description of utility1 - # return 1 + # #[para]Description of utility1 + # return 1 #} proc is_valid_tm_version {versionpart} { #Needs to be suitable for use with Tcl's 'package vcompare' - if {![catch [list package vcompare $versionparts $versionparts]]} { + if {![catch {package vcompare $versionpart $versionpart}]} { return 1 } else { return 0 @@ -327,12 +153,20 @@ namespace eval modpod::lib { } apply {{modfile} { if {$modfile eq "" || ![file exists $modfile]} { - error "modpod zip stub error. Unable to determine module path" + error "modpod zip stub error. Unable to determine module path" } set moddir [file dirname $modfile] set exedir [file dirname [file normalize [info nameofexecutable]]] set mod_and_ver [file rootname [file tail $modfile]] lassign [split $mod_and_ver -] moduletail version + #unwrapped redirect: an extracted #modpod-- folder (exact name-version match) + #beside the .tm takes precedence over mounting - the module can be manually unzipped in + #place and still load, with neither zipfs nor vfs::zip available. + set unwrapped_tm [file join $moddir #modpod-$mod_and_ver $mod_and_ver.tm] + if {[file exists $unwrapped_tm]} { + uplevel 1 [list source $unwrapped_tm] + return + } set do_intersect {{A B} { if {[llength $A] == 0} {return {}} if {[llength $B] == 0} {return {}} @@ -373,14 +207,14 @@ namespace eval modpod::lib { #early versions: zipfs::Mount mountpoint zipname #since 2023-09: zipfs::Mount zipname mountpoint #don't use 'file exists' when testing mountpoints. (some versions at least give massive delays on windows platform for non-existance) - #This is presumably related to // being interpreted as a network path + #This is presumably related to // being interpreted as a network path set mountpoints [dict keys [tcl::zipfs::mount]] if {"//zipfs:/$mount_at" ni $mountpoints} { - #despite API change tcl::zipfs package version was unfortunately not updated - so we don't know argument order without trying it + #despite API change tcl::zipfs package version was unfortunately not updated - so we don't know argument order without trying it if {[catch { #tcl::zipfs::mount $modfile //zipfs:/#mounted-modpod-$mod_and_ver ;#extremely slow if this is a wrong guess (artifact of aforementioned file exists issue ?) #puts "tcl::zipfs::mount $modfile $mount_at" - tcl::zipfs::mount $modfile $mount_at + tcl::zipfs::mount $modfile $mount_at } errM]} { #try old api if {![catch {tcl::zipfs::mount //zipfs:/$mount_at $modfile}]} { @@ -393,12 +227,12 @@ namespace eval modpod::lib { #tcl::zipfs::unmount //zipfs:/$mount_at error "Unable to find $mod_and_ver.tm in $modfile for module $fullpackage" } - } + } # #modpod-$mod_and_ver subdirectory always present in the archive so it can be conveniently extracted and run in that form uplevel 1 [list source //zipfs:/$mount_at/#modpod-$mod_and_ver/$mod_and_ver.tm] } else { #fallback to slower vfs::zip - #NB. We don't create the intermediate dirs - but the mount still works + #NB. We don't create the intermediate dirs - but the mount still works if {![file exists $exedir/$mount_at]} { if {[catch {package require vfs::zip} errM]} { @@ -416,7 +250,7 @@ namespace eval modpod::lib { } uplevel 1 [list source $exedir/$mount_at/#modpod-$mod_and_ver/$mod_and_ver.tm] } - }} [file normalize [info script]] + }} [file normalize [info script]] #zipped data follows }] @@ -439,7 +273,7 @@ namespace eval modpod::lib { namespace eval modpod::system { #*** !doctools #[subsection {Namespace modpod::system}] - #[para] Internal functions that are not part of the API + #[para] Internal functions that are not part of the API #deflate,store only supported @@ -458,7 +292,7 @@ namespace eval modpod::system { set size [tell $out] lappend report "modpod::system::make_mountable_zip" lappend report "tmfile : [file tail $outfile]" - lappend report "output size : $size" + lappend report "output size : $size" lappend report "offsettype : $offsettype" if {$offsettype eq "file"} { @@ -504,68 +338,50 @@ namespace eval modpod::system { binary scan $end_of_ctrl_dir issssiis eocd(signature) eocd(disknbr) eocd(ctrldirdisk) \ eocd(numondisk) eocd(totalnum) eocd(dirsize) eocd(diroffset) eocd(comment_len) - # 0x06054b50 - end of central dir signature - puts stderr "$end_of_ctrl_dir" - puts stderr "comment_len: $eocd(comment_len)" - puts stderr "eocd sig: $eocd(signature) [punk::lib::dec2hex $eocd(signature)]" lappend report "New dir offset: $eocd(diroffset)" lappend report "Adjusting $eocd(totalnum) zip file items." - catch { - punk::lib::showdict -roottype list -chan stderr $report ;#heavy dependencies - } - + seek $out $eocd(diroffset) for {set i 0} {$i <$eocd(totalnum)} {incr i} { set current_file [tell $out] set fileheader [read $out 46] - puts -------------- - puts [ansistring VIEW -lf 1 $fileheader] - puts -------------- - #binary scan $fileheader is2sss2ii2s3ssii x(sig) x(version) x(flags) x(method) \ - # x(date) x(crc32) x(sizes) x(lengths) x(diskno) x(iattr) x(eattr) x(offset) - binary scan $fileheader ic4sss2ii2s3ssii x(sig) x(version) x(flags) x(method) \ x(date) x(crc32) x(sizes) x(lengths) x(diskno) x(iattr) x(eattr) x(offset) - set ::last_header $fileheader - puts "sig: $x(sig) (hex: [punk::lib::dec2hex $x(sig)])" - puts "ver: $x(version)" - puts "method: $x(method)" - - #PK\1\2 + #PK\1\2 #33639248 dec = 0x02014b50 - central directory file header signature if { $x(sig) != 33639248 } { - error "modpod::system::make_mountable_zip Bad file header signature at item $i: dec:$x(sig) hex:[punk::lib::dec2hex $x(sig)]" + error "modpod::system::make_mountable_zip Bad file header signature at item $i: dec:$x(sig) hex:[punk::lib::dec2hex $x(sig)]" } - + foreach size $x(lengths) var {filename extrafield comment} { if { $size > 0 } { - set x($var) [read $out $size] + set x($var) [read $out $size] } else { set x($var) "" } } set next_file [tell $out] lappend report "file $i: $x(offset) $x(sizes) $x(filename)" - + seek $out [expr {$current_file+42}] puts -nonewline $out [binary format i [expr {$x(offset)+$stuboffset}]] - + #verify: flush $out seek $out $current_file set fileheader [read $out 46] - lappend report "old $x(offset) + $stuboffset" + lappend report "old $x(offset) + $stuboffset" binary scan $fileheader is2sss2ii2s3ssii x(sig) x(version) x(flags) x(method) \ x(date) x(crc32) x(sizes) x(lengths) x(diskno) x(iattr) x(eattr) x(offset) - lappend report "new $x(offset)" - - seek $out $next_file + lappend report "new $x(offset)" + + seek $out $next_file } } close $out - #pdict/showdict reuire punk & textlib - ie lots of dependencies + #pdict/showdict require punk & textlib - ie lots of dependencies #don't fall over just because of that catch { punk::lib::showdict -roottype list -chan stderr $report @@ -574,46 +390,14 @@ namespace eval modpod::system { return } - proc connect_if_not {{podpath ""}} { - upvar ::modpod::connected connected - set podpath [::modpod::system::normalize $podpath] - set docon 0 - if {![llength $connected(to)]} { - if {![string length $podpath]} { - error "modpod::system::connect_if_not - Not connected to a modpod file, and no podpath specified" - } else { - set docon 1 - } - } else { - if {![string length $podpath]} { - set podpath [lindex $connected(to) end] - puts stderr "modpod::system::connect_if_not WARNING: using last connected modpod:$podpath for operation\n -podpath not explicitly specified during operation: [info level -1]" - } else { - if {$podpath ni $connected(to)} { - set docon 1 - } - } - } - if {$docon} { - if {[lindex [modpod::connect $podpath]] 0] ne "ok"} { - error "modpod::system::connect_if_not error. file $podpath does not seem to be a valid modpod" - } else { - return $podpath - } - } - #we were already connected - return $podpath - } - proc myversion {} { - upvar ::modpod::connected connected set script [info script] if {![string length $script]} { error "No result from \[info script\] - modpod::system::myversion should only be called from within a loading modpod" } set fname [file tail [file rootname [file normalize $script]]] set scriptdir [file dirname $script] - + if {![string match "#modpod-*" $fname]} { lassign [lrange [split $fname -] end-1 end] _pkgname version } else { @@ -628,50 +412,29 @@ namespace eval modpod::system { } } } - - #tarjar::Log debug "'myversion' determined version for [info script]: $version" return $version } - proc myname {} { - upvar ::modpod::connected connected - set script [info script] - if {![string length $script]} { - error "No result from \[info script\] - modpod::system::myname should only be called from within a loading modpod" - } - return $connected(fullpackage,$script) - } - proc myfullname {} { - upvar ::modpod::connected connected - set script [info script] - #set script [::tarjar::normalize $script] - set script [file normalize $script] - if {![string length $script]} { - error "No result from \[info script\] - modpod::system::myfullname should only be called from within a loading tarjar" - } - return $::tarjar::connected(fullpackage,$script) - } proc normalize {path} { #newer versions of Tcl don't do tilde sub #Tcl's 'file normalize' seems to do some unfortunate tilde substitution on windows.. (at least for relative paths) # we take the assumption here that if Tcl's tilde substitution is required - it should be done before the path is provided to this function. - set matilda "<_tarjar_tilde_placeholder_>" ;#token that is *unlikely* to occur in the wild, and is somewhat self describing in case it somehow ..escapes.. + set matilda "<_modpod_tilde_placeholder_>" ;#token that is *unlikely* to occur in the wild, and is somewhat self describing in case it somehow ..escapes.. set path [string map [list ~ $matilda] $path] ;#give our tildes to matilda to look after set path [file normalize $path] #set path [string tolower $path] ;#must do this after file normalize return [string map [list $matilda ~] $path] ;#get our tildes back. -} + } } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -## Ready +## Ready package provide modpod [namespace eval modpod { variable pkg modpod variable version - set version 0.1.5 + set version 0.1.6 }] return #*** !doctools #[manpage_end] - diff --git a/src/tests/modules/AGENTS.md b/src/tests/modules/AGENTS.md index 2059b302..c73cbe40 100644 --- a/src/tests/modules/AGENTS.md +++ b/src/tests/modules/AGENTS.md @@ -39,6 +39,7 @@ Unit tests for editable source modules under `src/modules/`, `src/modules_tcl8/` - `opunk/console/` — ::opunk::Console backend subclass tests (`testsuites/console/backends.test`, G-001): virtual dispatch of subclass overrides through base-class calls and punk::console::console_spec_resolve (both unchanged), TestConsole determinism + probe-free at_eof, SshConsole capability/eof + the flagship size-via-ANSI-query-over-socket case (a scripted remote terminal answers CSI 6n), TkConsole widget size/eof (gated behind env PUNK_TEST_TK=1 - Tk in the shared testinterp has side effects; also verifiable standalone under a tk-capable kit e.g `punk91 src