diff --git a/CHANGELOG.md b/CHANGELOG.md index 04515850..7c6d8229 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,16 @@ 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.10.0] - 2026-07-11 + +- `dev lib.search` now performs deep module discovery by default: new `punk::libunknown::register_all_tm` registers `.tm` modules at every namespace depth across all tm paths (reusing/populating the per-epoch directory index cache, at most one scan per `package epoch` per interp), so namespaced modules in never-requested subfolders (e.g. `test::*`) appear in search results without `-refresh` (punk::mix::commandset::loadedlib 0.2.0). +- `dev lib.search -refresh` repurposed to mean a genuine filesystem re-scan: it increments the package epoch (invalidating punk::libunknown's scan caches) and re-runs discovery, picking up `.tm` files added/removed on disk and re-sourcing `pkgIndex.tcl` files. Without punk::libunknown active, `-refresh` retains the previous dummy-require deep-walk behaviour. +- lib.search dependency fixes: works in bare interps now — highlight ANSI codes computed only when highlighting (fully-qualified `punk::ansi` with inline require; previously errored on the shell-global `a+` alias even with `-highlight 0`), inline requires for `punk::path` (fallback walk) and `textblock` (table output). + +## [0.9.1] - 2026-07-11 + +- `dev lib.search` `-refresh` help rewritten to document actual semantics (punk::mix::commandset::loadedlib 0.1.1, doc-only): the flag performs a deep tm discovery pass (registering `.tm` modules in never-requested namespace subfolders), it does not re-scan directories already indexed in the current `package epoch` (run `package epoch incr` first for a genuine filesystem re-scan), and tm/auto_path list changes are epoch-invalidated automatically. New characterization test suites pin the underlying punk::libunknown discovery/epoch-cache behaviour (`src/tests/modules/punk/libunknown/testsuites/discovery/`) and the lib.search match + `-refresh` contract (`src/tests/modules/punk/mix/testsuites/loadedlib/`), including a GAP pin of the pkg-unknown handler clobbering a user global `dir` variable (stock Tcl keeps it proc-local). + ## [0.9.0] - 2026-07-11 - G-001 (in progress) increment 1: three pluggable `::opunk::Console` backend modules, with the base class and punk::console untouched — `opunk::console::test` (`::opunk::TestConsole`: deterministic channel-pair test double with fixed size and probe-free eof — the console seam the repl/editbuf characterization work needs), `opunk::console::ssh` (`::opunk::SshConsole`: socket-carried terminal sessions — construction-time capability, chan-eof without byte-consuming probes, and size resolved by punk::console's ANSI cursor-report provider *querying over the connection*, proven against a scripted remote terminal answering `CSI 6n` over a socket pair), and `opunk::console::tk` (`::opunk::TkConsole`: a Tk text widget as terminal — widget char dimensions as size, backend eof marker via `opunk::console::tk::set_eof`, verified live under the tk-capable punk91 kit). Subclass values dispatch through existing base-class holders and `console_spec_resolve` virtually. Remaining for the goal: repl launch-time console selection and output-channel parameterization. diff --git a/punkproject.toml b/punkproject.toml index 739b3f89..81d86325 100644 --- a/punkproject.toml +++ b/punkproject.toml @@ -1,3 +1,3 @@ [project] name = "punkshell" -version = "0.9.0" +version = "0.10.0" diff --git a/src/modules/punk/libunknown-0.1.tm b/src/modules/punk/libunknown-0.1.tm index eca0df03..a119a618 100644 --- a/src/modules/punk/libunknown-0.1.tm +++ b/src/modules/punk/libunknown-0.1.tm @@ -81,6 +81,10 @@ tcl::namespace::eval ::punk::libunknown { }] variable epoch ;#don't set - can be pre-set cooperatively + variable tm_fullscan [dict create] ;#tm epochs fully scanned by register_all_tm. + #Deliberately interp-local (NOT part of the shareable epoch dict): 'package ifneeded' + #registrations are interp-local, so an interp receiving a shared epoch must still run + #its own registration pass (cheap - directory listings come from the shared index cache). variable has_package_files if {[catch {package files foobaz}]} { @@ -1195,6 +1199,157 @@ tcl::namespace::eval ::punk::libunknown { } } + namespace eval argdoc { + variable PUNKARGS + lappend PUNKARGS [list { + @id -id ::punk::libunknown::register_all_tm + @cmd -name punk::libunknown::register_all_tm\ + -summary\ + "Deep discovery: register ifneeded scripts for all .tm modules at every namespace depth."\ + -help\ + "Walks every path in tcl::tm::list recursively and registers a 'package ifneeded' + script for each .tm module found - including modules in namespace subfolders + that have never been requested. (The tm package unknown handler registers + sibling .tm files only at the namespace depth of the package being required, + so such modules are otherwise absent from 'package names' until first + requested.) + + Existing ifneeded scripts are never overridden - first registration wins, + matching the tm unknown handler, so head-of-tm-list precedence for + same-version modules is preserved. + + Uses and populates the same per-epoch directory index cache as the unknown + handlers: for zipfs (static) paths the whole tree listing is gathered in one + call; for filesystem paths each directory's *.tm glob is cached per + 'package epoch'. Directories named #modpod-*, #tarjar-* and _build are + skipped. + + The scan runs at most once per tm epoch per interp (tracked in the + interp-local tm_fullscan variable - deliberately not part of the shareable + epoch dict, because ifneeded registrations are interp-local; an interp + receiving a shared epoch re-registers cheaply from the cached indexes). + Path-list changes and 'package epoch incr' start a new tm epoch, + re-enabling the scan - a call after 'package epoch incr' re-reads the + filesystem and picks up modules added or removed on disk. + + Returns a stats dict: epoch, roots, dirs, tmfiles, registered - plus + 'cached 1' when the call was a per-epoch no-op. + + punk::libunknown::init must have been called first." + @opts + -force -type none -help\ + "Run the registration pass even if already performed in the current tm epoch. + Directory listings still come from the epoch index cache where present - + use 'package epoch incr' first to force re-reading the filesystem." + }] + } + proc register_all_tm {args} { + variable epoch + if {![info exists epoch]} { + error "punk::libunknown::register_all_tm - punk::libunknown::init has not been called in this interp" + } + set opt_force [expr {"-force" in $args}] + variable tm_fullscan + set tm_epoch [dict get $epoch tm current] + if {!$opt_force && [dict exists $tm_fullscan $tm_epoch]} { + return [dict merge [dict get $tm_fullscan $tm_epoch] [dict create cached 1]] + } + upvar ::tcl::tm::paths paths + upvar ::tcl::tm::pkgpattern pkgpattern + + if {[info commands ::tcl::zipfs::root] ne ""} { + set zipfsroot [tcl::zipfs::root] + set has_zipfs 1 + } else { + set zipfsroot "//zipfs:/" ;#doesn't matter much what we use here - don't expect in tm list if no zipfs commands + set has_zipfs 0 + } + set stat_roots 0 + set stat_dirs 0 + set stat_files 0 + set stat_registered 0 + foreach path $paths { + if {![interp issafe] && ![file exists $path]} { + continue + } + incr stat_roots + set tmfiles [list] + if {$has_zipfs && [string match $zipfsroot* $path]} { + #static filesystem - the whole tm tree is available in one quick call + #(as the tm unknown handler's zipfs branch does) + set tmfiles [::tcl::zipfs::list $path/*.tm] + set seen_dirs [dict create] + foreach tm_path $tmfiles { + set d [file dirname $tm_path] + dict set seen_dirs $d 1 + dict set epoch tm epochs $tm_epoch indexes $d $tm_path $tm_epoch + } + incr stat_dirs [dict size $seen_dirs] + } else { + #plain filesystem - breadth-first walk, reusing/populating the per-epoch + #directory index cache so the unknown handlers can short-circuit later + set pending [list $path] + while {[llength $pending]} { + set current [lindex $pending 0] + set pending [lrange $pending 1 end] + incr stat_dirs + if {[dict exists $epoch tm epochs $tm_epoch indexes $current]} { + set dirfiles [dict keys [dict get $epoch tm epochs $tm_epoch indexes $current]] + } else { + set dirfiles [glob -nocomplain -directory $current -types f *.tm] + dict set epoch tm epochs $tm_epoch indexes $current [dict create] + foreach f $dirfiles { + dict set epoch tm epochs $tm_epoch indexes $current $f $tm_epoch + } + } + lappend tmfiles {*}$dirfiles + foreach sub [glob -nocomplain -directory $current -types d *] { + set tail [file tail $sub] + if {[string match "#modpod-*" $tail] || [string match "#tarjar-*" $tail] || $tail eq "_build"} { + continue + } + lappend pending $sub + } + } + } + #registration - same rules as the tm unknown handler (don't override existing + #ifneeded scripts: for tm modules the first encountered 'wins') + set strip [llength [file split $path]] + foreach file $tmfiles { + if {[string match "*/_build/*" $file]} { + continue + } + incr stat_files + set pkgfilename [join [lrange [file split $file] $strip end] ::] + if {![regexp -- $pkgpattern $pkgfilename --> pkgname pkgversion]} { + # Ignore everything not matching our pattern for package names. + continue + } + try { + package vcompare $pkgversion 0 + } on error {} { + # Ignore everything where the version part is not acceptable to + # "package vcompare". + continue + } + if {([package ifneeded $pkgname $pkgversion] ne {}) && (![interp issafe])} { + #already registered - possibly by an earlier (higher precedence) path + dict set epoch tm epochs $tm_epoch added $path $pkgname $pkgversion e$tm_epoch + dict unset epoch tm untracked $pkgname + continue + } + package ifneeded $pkgname $pkgversion \ + "[::list package provide $pkgname $pkgversion];[::list source $file]" + incr stat_registered + dict set epoch tm epochs $tm_epoch added $path $pkgname $pkgversion e$tm_epoch + dict unset epoch tm untracked $pkgname + } + } + set stats [dict create epoch $tm_epoch roots $stat_roots dirs $stat_dirs tmfiles $stat_files registered $stat_registered] + dict set tm_fullscan $tm_epoch $stats + return $stats + } + #see what basic info we can gather *quickly* about the indexes for each version of a pkg that the package db knows about. #we want no calls out to the actual filesystem - but we can use some 'file' calls such as 'file dirname', 'file split' (review -safe interp problem) #in practice the info is only available for tm modules diff --git a/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm b/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm index 59d2e84a..b59bec40 100644 --- a/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm @@ -28,13 +28,37 @@ namespace eval punk::mix::commandset::loadedlib { #search automatically wrapped in * * - can contain inner * ? globs punk::args::define { @id -id ::punk::mix::commandset::loadedlib::search - @cmd -name "punk::mix::commandset::loadedlib search" -help "search all Tcl libraries available to your local interpreter" + @cmd -name "punk::mix::commandset::loadedlib search" -help\ + "search all Tcl libraries available to your local interpreter. + When punk::libunknown is active (the punkshell default) a deep module + discovery pass runs first, so .tm modules at every namespace depth are + included - cached per 'package epoch', repeat searches are cheap. + See -refresh for cache/re-scan details." -return -type string -default table -choices {table tableobject list lines} -present -type integer -default 2 -choices {0 1 2} -choicelabels {absent present both} -help\ "(unimplemented) Display only those that are 0:absent 1:present 2:either" -highlight -type boolean -default 1 -help\ "Highlight which version is present with ansi underline and colour" - -refresh -type none -help "Re-scan the tm and library folders" + -refresh -type none -help\ + "Force a genuine filesystem re-scan of the module and library folders. + When punk::libunknown is active (the punkshell default), every search + already performs a deep module discovery pass - registering .tm modules + at every namespace depth across all tcl::tm::list paths (see + punk::libunknown::register_all_tm) - cached per 'package epoch' so + repeat searches are cheap. Because directories already indexed in the + current epoch are not re-globbed, that default pass does not notice .tm + files added to (or removed from) already-scanned folders. + -refresh increments the package epoch ('package epoch incr'), + invalidating the scan caches, then re-runs discovery - picking up + on-disk changes and re-sourcing the pkgIndex.tcl files on ::auto_path. + Changes to tcl::tm::list or ::auto_path increment the epoch + automatically (via variable traces) - this flag is not needed for + those cases. + When punk::libunknown is not active there is no epoch cache: the + default search reflects only packages already registered in the + package database, and -refresh performs the (comparatively expensive) + deep discovery walk directly using dummy package require calls at + each namespace depth." searchstring -default * -multiple 1 -help\ "Names to search for, may contain glob chars (* ?) e.g *lib* If no glob chars are explicitly specified, the searchstring will be wrapped with star globs. @@ -51,19 +75,47 @@ namespace eval punk::mix::commandset::loadedlib { set opt_highlight [dict get $opts -highlight] set opt_refresh [dict exists $received -refresh] - if {$opt_refresh} { - catch {package require frobznodule666} ;#ensure pkg system has loaded/searched for everything REVIEW - this doesn't result in full scans - foreach tm_path [tcl::tm::list] { - set paths_below [punk::path::subfolders -recursive $tm_path] - foreach folder $paths_below { - set tail [file tail $folder] - if {[string match #modpod-* $tail] || [string match #tarjar-* $tail]} { - continue + #Deep discovery of available packages. + #The package unknown handlers register .tm siblings only at the namespace depth + #being requested - modules in never-requested subfolders are absent from + #'package names' until a deep pass registers them. + #Note: ::info must be fully qualified here - this namespace defines its own 'info' proc + if {[::info commands ::punk::libunknown::register_all_tm] ne "" && [::info exists ::punk::libunknown::epoch]} { + if {$opt_refresh} { + #genuine filesystem re-scan: start a new package epoch so the scan + #caches are invalidated (pkgIndex.tcl files on ::auto_path will also be + #re-sourced by the dummy require below) + package epoch incr + } + #register .tm modules at every namespace depth (cached per tm epoch - + #repeat searches are cheap) + punk::libunknown::register_all_tm + #sweep the pkgIndex.tcl files of ::auto_path for library-style packages + catch {package require frobznodule666} + } else { + #punk::libunknown deep registration unavailable - without its epoch cache a + #recursive walk on every search would be expensive, so deep discovery runs + #only on explicit request. + if {$opt_refresh} { + if {[::info exists ::punk::libunknown::epoch]} { + #older punk::libunknown without register_all_tm: invalidate its scan + #caches so the dummy requires below re-read the filesystem + catch {package epoch incr} + } + catch {package require frobznodule666} ;#top-level tm scan + pkgIndex sweep of ::auto_path + package require punk::path + foreach tm_path [tcl::tm::list] { + set paths_below [punk::path::subfolders -recursive $tm_path] + foreach folder $paths_below { + set tail [file tail $folder] + if {[string match #modpod-* $tail] || [string match #tarjar-* $tail]} { + continue + } + if {[string match */_build/* $folder]} {continue} + set relpath [string tolower [punk::path::relative $tm_path $folder]] + set modpath [string map {/ ::} $relpath] + catch {package require ${modpath}::flobrudder99} } - if {[string match */_build/* $folder]} {continue} - set relpath [string tolower [punk::path::relative $tm_path $folder]] - set modpath [string map {/ ::} $relpath] - catch {package require ${modpath}::flobrudder99} } } } @@ -85,8 +137,12 @@ namespace eval punk::mix::commandset::loadedlib { } set matches [lsort -unique $matches] set matchinfo [list] - set highlight_ansi [a+ web-limegreen underline] - set RST [a] + if {$opt_highlight} { + #not a module-top require: punk::ansi is only needed for highlighting + package require punk::ansi + set highlight_ansi [punk::ansi::a+ web-limegreen underline] + set RST [punk::ansi::a] + } foreach m $matches { set versions [package versions $m] if {![llength $versions]} { @@ -122,6 +178,7 @@ namespace eval punk::mix::commandset::loadedlib { return [join $matchinfo \n] } table - tableobject { + package require textblock set t [textblock::class::table new] $t add_column -headers "Package" $t add_column -headers "Version" diff --git a/src/modules/punk/mix/commandset/loadedlib-buildversion.txt b/src/modules/punk/mix/commandset/loadedlib-buildversion.txt index f47d01c8..673b4a5c 100644 --- a/src/modules/punk/mix/commandset/loadedlib-buildversion.txt +++ b/src/modules/punk/mix/commandset/loadedlib-buildversion.txt @@ -1,3 +1,7 @@ -0.1.0 +0.2.0 #First line must be a semantic version number #all other lines are ignored. +#0.2.0 - search now performs deep module discovery by default when punk::libunknown is active: calls new punk::libunknown::register_all_tm (registers .tm modules at every namespace depth, cached per 'package epoch') plus the pkgIndex.tcl sweep of ::auto_path - so namespaced modules in never-requested subfolders (e.g test::*) appear without -refresh +#0.2.0 - -refresh repurposed to mean a genuine filesystem re-scan: increments the package epoch first (invalidating punk::libunknown's scan caches) then re-runs discovery, picking up .tm files added/removed on disk and re-sourcing pkgIndex.tcl files; without punk::libunknown (or with an older copy lacking register_all_tm) -refresh falls back to the previous behaviour (deep discovery walk via dummy package require calls at each namespace depth) +#0.2.0 - dependency fixes: highlight ansi codes now computed only when -highlight 1 using fully-qualified punk::ansi::a+/a with an inline package require (previously relied on shell-global a+ alias unconditionally and errored in bare interps even with -highlight 0); inline package require punk::path in the fallback -refresh walk and package require textblock in the table/tableobject return branch (previously assumed the shell environment had loaded them) +#0.1.1 - doc-only: rewrote 'search -refresh' PUNKARGS help to document actual semantics - a deep tm discovery pass (dummy requires at each namespace depth so ifneeded scripts get registered for .tm modules in never-requested subfolders), not a filesystem re-scan; within an epoch the punk::libunknown index cache short-circuits re-globbing of already-scanned dirs (run 'package epoch incr' first for a genuine re-scan); tm/auto_path list changes are handled automatically by epoch traces and don't need the flag diff --git a/src/tests/modules/AGENTS.md b/src/tests/modules/AGENTS.md index b6c1341a..11bd9bcd 100644 --- a/src/tests/modules/AGENTS.md +++ b/src/tests/modules/AGENTS.md @@ -42,8 +42,8 @@ Unit tests for editable source modules under `src/modules/`, `src/modules_tcl8/` - `punk/ansi/` — punk::ansi tests (`testsuites/ansi/`): ansistrip/ansimerge, plus characterization of the ANSI-at-position mechanisms (`ansistring.test`: INDEX/INDEXCODE/INDEXCHAR/RANGE/INSERT grapheme indexing with SGR-prefix merging, INDEXCOLUMNS/COLUMNINDEX double-wide column mapping, trim/VIEW), code splitting invariants (`ta.test`: detect/detectcode distinction, split_codes/split_codes_single/split_at_codes shapes and round-trip) and single-code/effective-state semantics (`codetype.test`: is_sgr_reset/has_sgr_leadingreset, has_any/all_effective, sgr_merge, sequence_type classify). ANSI codes in these tests are literal escape strings so results are colour-state independent - `punk/args/` — punk::args tests (`testsuites/args/`): parsing, choices/choicegroups, forms, rendering/indentation characterization, usage-marking characterization (`usagemarking.test`: -parsedargs/-badarg/-parsestatus/-scheme marking primitives plus goodchoice highlighting of selected/default-in-effect choice words, asserted by SGR-parameter subset against the live colour arrays; the G-049 nocolour/colour-leak GAP pins flipped 2026-07-10 to scheme-statelessness assertions), the G-049 parse-status structure (`parsestatus.test`: punk::args::parse_status overall/per-argument statuses, badarg for type/allocation failures, -caller attribution, errorcode -argspecs stripping), and tclcore doc/interpreter behavioural parity (`tclcoreparity.test`, G-054, gated on have_tclcoredocs: 'string is' class choices equal the live-harvested set, per-class docids exist, error-vs-ok agreement across the probe matrix, version-note labels conditional on class presence - expectations derived from the running interpreter, green on 8.6/8.7/9.0; under 8.6 run the file directly via a plain tclkit + tcltest driver since runtests' harness needs newer infrastructure) - `punk/ns/` — punk::ns tests (`testsuites/ns/`): cmdwhich/cmdinfo/cmd_traverse doc-lookup flow (`cmdflow.test`, G-040 parity) and cmdhelp usage-rendering integration (`cmdhelp.test`: scheme selection, goodarg/badarg marking incl type/allocation failures, goodchoice highlighting of supplied/default choice words, alias path, cmdinfo result shape, queried-command failure attribution, and `-return dict` parse-status returns (G-049 - its GAP pins flipped 2026-07-10); remaining GAP pins for pseudo-command cmdtype + space-form docid prefixes (G-051, real `string is` pins behind the have_tclcoredocs constraint), TclOO undocumented-method fallback (G-052), and synopsis marking absence (G-050)) -- `punk/mix/` — punk::mix::cli tests (prune helpers, punkcheck virtual sources), punk::mix::commandset::repo fossil move/rename characterization tests (`testsuites/repo/`, FOSSIL_HOME-isolated; GAP-marked tests pin behaviour G-022 will change), and the MULTISHELL polyglot build machinery (`testsuites/scriptwrap/multishell.test`: scriptset wrap via the punk.multishell.cmd template - structure/LF-only/determinism, checkfile 512-byte label validation of fresh wraps AND the committed bin/runtime.cmd, the runtime scriptset round-trip byte-identity pin, and platform-gated execution smoke: cmd.exe→powershell payload on windows, sh payload on unix or via the `wsllinux` capability constraint from `src/tests/testsupport/wslprobe.tcl` - staged to the WSL distro's native filesystem, G-059) +- `punk/mix/` — punk::mix::cli tests (prune helpers, punkcheck virtual sources), punk::mix::commandset::repo fossil move/rename characterization tests (`testsuites/repo/`, FOSSIL_HOME-isolated; GAP-marked tests pin behaviour G-022 will change), punk::mix::commandset::loadedlib tests (`testsuites/loadedlib/libsearch.test`: 'dev lib.search' match semantics via -return list — wrap-glob default, =exact prefix, case rules, explicit globs, version aggregation — plus the loadedlib 0.2.0 contract: deep discovery by default (deep .tm modules found without -refresh, registration persists), -refresh = genuine re-scan (epoch incr + rediscovery picks up .tm files added to already-scanned dirs), and highlight working without the shell-global a+ alias; shared provisioned child interp sourcing the source-tree libunknown directly — see the file's ORDERING NOTE), and the MULTISHELL polyglot build machinery (`testsuites/scriptwrap/multishell.test`: scriptset wrap via the punk.multishell.cmd template - structure/LF-only/determinism, checkfile 512-byte label validation of fresh wraps AND the committed bin/runtime.cmd, the runtime scriptset round-trip byte-identity pin, and platform-gated execution smoke: cmd.exe→powershell payload on windows, sh payload on unix or via the `wsllinux` capability constraint from `src/tests/testsupport/wslprobe.tcl` - staged to the WSL distro's native filesystem, G-059) - `punk/lib/` — punk::lib tests (`testsuites/lib/`): range/index/parse/compat/interp_sync utilities, G-058 static-baseline seeding (`staticseed.test`: interp_sync_package_paths/snapshot_package_paths propagate a simulated ::punkboot static baseline and seed `load {} ` ifneeded mappings; no-op without a baseline), and the repl command-completeness engine (`commandcomplete.test`: punk::lib::system::incomplete pending-opener stacks - the info-complete quoting quirk progression (`set x "{*}{"` standalone vs in-proc-body), single openers, tabs, escapes, incomplete<->info-complete parity property; pre-repl-refactor characterization, see goals/G-044 detail preserve-list) - `punk/packagepreference/` — punk::packagepreference tests (`testsuites/packagepreference/`): G-058 static-vs-bundled policy (`staticpolicy.test`: require of a baseline package triggers the index scan before resolution so a newer bundled copy wins, static beats older bundled, exact requires of bundled versions stay reachable, missing static mappings get seeded) -- `punk/libunknown/` — .tm same-version shadowing pin-tests (`testsuites/shadowing/`): tcl::tm::add prepend rule, head-of-tm-list wins exact-version ties, version beats order, punk::libunknown parity — shipped behaviour depends on these (runtests tm ordering, punk_main package-mode precedence, G-033); mixed .tm/pkgIndex.tcl characterization is goal G-035 +- `punk/libunknown/` — .tm same-version shadowing pin-tests (`testsuites/shadowing/`): tcl::tm::add prepend rule, head-of-tm-list wins exact-version ties, version beats order, punk::libunknown parity — shipped behaviour depends on these (runtests tm ordering, punk_main package-mode precedence, G-033); mixed .tm/pkgIndex.tcl characterization is goal G-035; discovery/epoch-cache characterization (`testsuites/discovery/discovery.test`): sibling .tm registration happens only at the requested namespace depth (deeper modules invisible to 'package names' until requested), register_all_tm deep discovery (all-depths registration, per-epoch cached no-op, head-of-tm-list precedence parity), 'package epoch' command shape, trace-driven epoch increments on tm/auto_path changes, the epoch-index short-circuit (a .tm added to an already-scanned dir needs 'package epoch incr'), plus a GAP pin of zipfs_tclPkgUnknown clobbering a user global 'dir' (stock tclPkgUnknown keeps dir proc-local; fix candidate). Suite conventions learned the hard way: child probes source the SOURCE-TREE libunknown directly by path — 'package require punk::libunknown' tie-breaks the same-version copies (src/modules vs bootsupport) by tm path order, which favours bootsupport in the testinterp and machine env paths in children; and probe scripts must avoid global variable names the handlers use (notably 'dir') — that clobbering misdirected a fixture write into the real Tcl install during test development diff --git a/src/tests/modules/punk/libunknown/testsuites/discovery/discovery.test b/src/tests/modules/punk/libunknown/testsuites/discovery/discovery.test new file mode 100644 index 00000000..0b57013a --- /dev/null +++ b/src/tests/modules/punk/libunknown/testsuites/discovery/discovery.test @@ -0,0 +1,319 @@ +# -*- tcl -*- +# Characterization tests for punk::libunknown module discovery semantics and +# the epoch-based scan cache ('package epoch' machinery installed by +# punk::libunknown::init). +# +# Behaviours pinned here (verified experimentally 2026-07-11 on Tcl 9.0.3): +# 1. The tm unknown handler registers ifneeded scripts for ALL sibling .tm +# files in a scanned directory - but only at the namespace depth of the +# requested package. Modules in deeper (never-requested) subfolders stay +# absent from 'package names'. This laziness is deliberate (minimal scan +# cost in new interps/threads/subshells); punk::libunknown::register_all_tm +# provides the explicit deep discovery pass (used by 'dev lib.search' by +# default - see src/tests/modules/punk/mix/testsuites/loadedlib/libsearch.test). +# 2. Within one epoch, directories already indexed are not re-globbed: a .tm +# file added on disk to an already-scanned directory is invisible to +# 'package require' until 'package epoch incr'. +# 3. Traces on ::tcl::tm::paths and ::auto_path increment the tm/pkg epoch +# automatically - no manual invalidation needed for path-list changes. +# +# Run: tclsh src/tests/runtests.tcl -report compact -show-passes 0 -include-paths modules/punk/libunknown/** discovery.test + +package require tcltest +package require punk::lib + +namespace eval ::testspace { + namespace import ::tcltest::* + + # ------------------------------------------------------------------------- + # Fixture: a tm tree with distinctively named modules at three namespace + # depths, plus a separate mutation dir for the epoch-cache tests. + # fix/pklu_top-1.0.tm (pklu_top) + # fix/pklu_sib-1.0.tm (pklu_sib) + # fix/pkluns/leafmod-1.0.tm (pkluns::leafmod) + # fix/pkluns/leafsib-1.0.tm (pkluns::leafsib) + # fix/pkluns/subns/verydeep-1.0.tm (pkluns::subns::verydeep) + # mut/pklu_mtop-1.0.tm (pklu_mtop) + # mut2/pklu_m2top-1.0.tm (pklu_m2top - register_all_tm mutation tests) + # sdirA/pklu_shadow-1.0.tm (impl A - register_all_tm precedence pin) + # sdirB/pklu_shadow-1.0.tm (impl B - register_all_tm precedence pin) + # epochextra/ (empty - target for tm::add) + # ------------------------------------------------------------------------- + variable fixture_error "" + variable fixdir "" + variable mutdir "" + variable mut2dir "" + variable sdirA "" + variable sdirB "" + variable epochextra "" + try { + set base [punk::lib::tempdir_newfolder -prefix pkludiscovery] + set fixdir [file join $base fix] + set mutdir [file join $base mut] + set mut2dir [file join $base mut2] + set sdirA [file join $base sdirA] + set sdirB [file join $base sdirB] + set epochextra [file join $base epochextra] + file mkdir [file join $fixdir pkluns subns] $mutdir $mut2dir $sdirA $sdirB $epochextra + foreach {relpath content} { + {pklu_top-1.0.tm} {package provide pklu_top 1.0} + {pklu_sib-1.0.tm} {package provide pklu_sib 1.0} + {pkluns/leafmod-1.0.tm} {package provide pkluns::leafmod 1.0} + {pkluns/leafsib-1.0.tm} {package provide pkluns::leafsib 1.0} + {pkluns/subns/verydeep-1.0.tm} {package provide pkluns::subns::verydeep 1.0} + } { + set fd [open [file join $fixdir {*}[file split $relpath]] w] + puts $fd $content + close $fd + } + set fd [open [file join $mutdir pklu_mtop-1.0.tm] w] + puts $fd {package provide pklu_mtop 1.0} + close $fd + set fd [open [file join $mut2dir pklu_m2top-1.0.tm] w] + puts $fd {package provide pklu_m2top 1.0} + close $fd + set fd [open [file join $sdirA pklu_shadow-1.0.tm] w] + puts $fd {package provide pklu_shadow 1.0; proc ::pklu_shadow_whoami {} {return A}} + close $fd + set fd [open [file join $sdirB pklu_shadow-1.0.tm] w] + puts $fd {package provide pklu_shadow 1.0; proc ::pklu_shadow_whoami {} {return B}} + close $fd + variable tempbase $base + } on error {result} { + set fixture_error $result + } + testConstraint discoveryfixture [expr {$fixture_error eq ""}] + if {$fixture_error ne ""} { + puts stderr "discovery.test fixture setup failed (tests will be skipped): $fixture_error" + } + + #The SOURCE-TREE punk::libunknown, located relative to this test file. + #A 'package require punk::libunknown' would tie-break the same-version (0.1) + #copies in src/modules and src/bootsupport/modules by tm path order - in the + #testinterp that order deliberately favours bootsupport, and in a child interp + #it depends on machine-specific env tm paths. These tests must exercise the + #source copy, so it is sourced directly by path (as punk_main.tcl loads it). + variable libunknown_src "" + variable script_dir [file dirname [file normalize [info script]]] + set srcmodules [file normalize [file join $script_dir .. .. .. .. .. .. modules]] + set candidates [lsort [glob -nocomplain [file join $srcmodules punk libunknown-*.tm]]] + if {[llength $candidates]} { + set libunknown_src [lindex $candidates end] + } + testConstraint libunknownavailable [expr {$libunknown_src ne ""}] + if {$libunknown_src eq ""} { + puts stderr "discovery.test: cannot locate src/modules/punk/libunknown-*.tm relative to [info script] (tests will be skipped)" + } + + # ------------------------------------------------------------------------- + # Probe: fresh child interp with the source-tree punk::libunknown active and + # tm paths set to exactly $tmdirs. Returns the script's result; child + # deleted after. + # ------------------------------------------------------------------------- + proc libu_probe {tmdirs script} { + variable libunknown_src + set i [interp create] + try { + interp eval $i {package prefer latest} + interp eval $i {tcl::tm::remove {*}[tcl::tm::list]} + interp eval $i [list source $libunknown_src] + interp eval $i {punk::libunknown::init} + interp eval $i [list tcl::tm::add {*}$tmdirs] + interp eval $i $script + } finally { + interp delete $i + } + } + + #added 2026-07-11 (agent) - coverage prep for lib.search deep-discovery work (punk::mix::commandset::loadedlib) + + # -- handler installation --------------------------------------------------- + + test libunknown_init_installs_handlers {init sets package unknown to the two-handler libunknown chain}\ + -constraints {discoveryfixture libunknownavailable} -body { + variable fixdir + libu_probe [list $fixdir] {package unknown} + } -result {::punk::libunknown::zipfs_tm_UnknownHandler ::punk::libunknown::zipfs_tclPkgUnknown} + + # -- sibling registration / lazy depth ---------------------------------------- + + test discovery_sibling_same_depth {requiring one module registers sibling .tm files at the same depth}\ + -constraints {discoveryfixture libunknownavailable} -body { + variable fixdir + libu_probe [list $fixdir] { + package require pklu_top + list [expr {"pklu_sib" in [package names]}] [package require pklu_sib] + } + } -result {1 1.0} + + test discovery_lazy_depth {deeper unrequested modules stay unregistered after a top-level scan}\ + -constraints {discoveryfixture libunknownavailable} -body { + variable fixdir + libu_probe [list $fixdir] { + package require pklu_top + list [expr {"pkluns::leafmod" in [package names]}]\ + [expr {"pkluns::subns::verydeep" in [package names]}] + } + } -result {0 0} + + test discovery_deep_registers_requested_depth_only {requiring a deep module registers its siblings but not deeper levels}\ + -constraints {discoveryfixture libunknownavailable} -body { + variable fixdir + libu_probe [list $fixdir] { + package require pkluns::leafmod + list [package provide pkluns::leafmod]\ + [expr {"pkluns::leafsib" in [package names]}]\ + [expr {"pkluns::subns::verydeep" in [package names]}] + } + } -result {1.0 1 0} + + # -- 'package epoch' machinery ------------------------------------------------ + + test epoch_command_shape {package epoch returns a dict with integer tm and pkg epoch counters}\ + -constraints {discoveryfixture libunknownavailable} -body { + variable fixdir + libu_probe [list $fixdir] { + set e [package epoch] + list [dict exists $e tm] [dict exists $e pkg]\ + [string is integer -strict [dict get $e tm]]\ + [string is integer -strict [dict get $e pkg]] + } + } -result {1 1 1 1} + + test epoch_incr_on_tm_paths_change {tcl::tm::add increments the tm epoch via the paths trace}\ + -constraints {discoveryfixture libunknownavailable} -body { + variable fixdir + variable epochextra + libu_probe [list $fixdir] [string map [list %DIR% [list $epochextra]] { + set before [dict get [package epoch] tm] + tcl::tm::add %DIR% + expr {[dict get [package epoch] tm] > $before} + }] + } -result 1 + + test epoch_incr_on_auto_path_change {writing ::auto_path increments the pkg epoch via the variable trace}\ + -constraints {discoveryfixture libunknownavailable} -body { + variable fixdir + variable epochextra + libu_probe [list $fixdir] [string map [list %DIR% [list $epochextra]] { + set before [dict get [package epoch] pkg] + lappend ::auto_path %DIR% + expr {[dict get [package epoch] pkg] > $before} + }] + } -result 1 + + test epoch_incr_subcommand {package epoch incr increments both tm and pkg epochs}\ + -constraints {discoveryfixture libunknownavailable} -body { + variable fixdir + libu_probe [list $fixdir] { + set before [package epoch] + package epoch incr + set after [package epoch] + list [expr {[dict get $after tm] > [dict get $before tm]}]\ + [expr {[dict get $after pkg] > [dict get $before pkg]}] + } + } -result {1 1} + + test epoch_cache_blocks_new_tm_until_incr {a .tm added to an already-scanned dir is invisible until package epoch incr}\ + -constraints {discoveryfixture libunknownavailable} -body { + variable mutdir + #the target path is string-mapped in as a literal: a child-global 'dir' + #variable would be clobbered by the package unknown chain (see + #libunknown_GAP_pkgunknown_clobbers_global_dir) + libu_probe [list $mutdir] [string map [list %MUT% [list $mutdir]] { + #scan the dir within the current epoch + package require pklu_mtop + #new module appears on disk after the scan + set ::t_fd [open [file join %MUT% pklu_newsib-1.0.tm] w] + puts $::t_fd {package provide pklu_newsib 1.0} + close $::t_fd + set ::t_result [list] + #same epoch: the cached index short-circuits the re-glob + lappend ::t_result [catch {package require pklu_newsib}] + #the documented recipe: epoch incr drops non-static indexes -> rescan + package epoch incr + lappend ::t_result [package require pklu_newsib] + }] + } -result {1 1.0} + + # -- register_all_tm (deep discovery) ------------------------------------------- + + #added 2026-07-11 (agent) - punk::libunknown::register_all_tm, the deep-discovery + #pass 'dev lib.search' uses by default (loadedlib 0.2.0) + test register_all_tm_all_depths {register_all_tm registers .tm modules at every namespace depth in one pass}\ + -constraints {discoveryfixture libunknownavailable} -body { + variable fixdir + libu_probe [list $fixdir] { + punk::libunknown::register_all_tm + list [expr {"pklu_top" in [package names]}]\ + [expr {"pkluns::leafmod" in [package names]}]\ + [expr {"pkluns::subns::verydeep" in [package names]}]\ + [package require pkluns::subns::verydeep] + } + } -result {1 1 1 1.0} + + test register_all_tm_cached_per_epoch {repeat call is a per-epoch no-op; package epoch incr re-enables a filesystem scan}\ + -constraints {discoveryfixture libunknownavailable} -body { + variable mut2dir + libu_probe [list $mut2dir] [string map [list %MUT% [list $mut2dir]] { + punk::libunknown::register_all_tm + #new module appears on disk after the scan + set ::t_fd [open [file join %MUT% pklu_m2new-1.0.tm] w] + puts $::t_fd {package provide pklu_m2new 1.0} + close $::t_fd + set ::t_result [list] + #second call in the same epoch: cached no-op - new file not seen + lappend ::t_result [dict exists [punk::libunknown::register_all_tm] cached] + lappend ::t_result [expr {"pklu_m2new" in [package names]}] + #new epoch: scan re-reads the filesystem + package epoch incr + punk::libunknown::register_all_tm + lappend ::t_result [expr {"pklu_m2new" in [package names]}] + }] + } -result {1 0 1} + + test register_all_tm_headwins_parity {same name-version in two tm dirs: head of tm list wins (parity with the unknown handler)}\ + -constraints {discoveryfixture libunknownavailable} -body { + variable sdirA + variable sdirB + #tcl::tm::add prepends: the LAST dir passed ends up at the head of the + #tm list and must win the same-version tie (see shadowing.test pins) + set r1 [libu_probe [list $sdirA $sdirB] { + punk::libunknown::register_all_tm + package require pklu_shadow + pklu_shadow_whoami + }] + set r2 [libu_probe [list $sdirB $sdirA] { + punk::libunknown::register_all_tm + package require pklu_shadow + pklu_shadow_whoami + }] + list $r1 $r2 + } -result {B A} + + #GAP: pins a divergence from stock Tcl that is a candidate for fixing. + #Stock tclPkgUnknown keeps 'dir' proc-local (pkgIndex.tcl files are sourced + #in the proc's scope). punk::libunknown::zipfs_tclPkgUnknown sources index + #files at :: scope and therefore declares 'global dir' - clobbering any + #user global named 'dir' whenever a package require falls through to the + #pkg unknown handler. If that is fixed (e.g save/restore ::dir), the + #expected result flips to 1. + test libunknown_GAP_pkgunknown_clobbers_global_dir {a global 'dir' variable is overwritten by a package unknown fallthrough}\ + -constraints {discoveryfixture libunknownavailable} -body { + variable fixdir + libu_probe [list $fixdir] { + set ::dir preserved_value + catch {package require pklu_nonexistent_zzz} + expr {$::dir eq "preserved_value"} + } + } -result 0 + + # cleanup fixture + variable tempbase + if {[info exists tempbase] && $tempbase ne "" && [file isdirectory $tempbase]} { + catch {file delete -force $tempbase} + } +} + +tcltest::cleanupTests +namespace delete ::testspace diff --git a/src/tests/modules/punk/mix/testsuites/loadedlib/libsearch.test b/src/tests/modules/punk/mix/testsuites/loadedlib/libsearch.test new file mode 100644 index 00000000..9718208f --- /dev/null +++ b/src/tests/modules/punk/mix/testsuites/loadedlib/libsearch.test @@ -0,0 +1,213 @@ +# -*- tcl -*- +# Tests for punk::mix::commandset::loadedlib::search ('dev lib.search'): +# match semantics (-return list) and the -refresh deep-discovery contract, +# exercised in an isolated child interp with punk::libunknown active and +# fixture-only tm search paths. +# +# Contract (loadedlib 0.2.0): with punk::libunknown active, search performs +# deep module discovery by default (punk::libunknown::register_all_tm - cached +# per 'package epoch'), so .tm modules at every namespace depth are found +# without -refresh. -refresh means a genuine filesystem re-scan: it increments +# the package epoch (invalidating the scan caches) then re-runs discovery. +# +# Environment note: loadedlib 0.2.0 no longer needs the shell-provided global +# 'a+'/'a' aliases or a pre-loaded punk::path - the child setup below +# deliberately provides neither, pinning that self-containment. (punk::ansi is +# pre-required in the child only because the fixture-trimmed tm paths cannot +# resolve it later; the highlight test exercises search's own qualified +# punk::ansi calls without any global alias.) +# +# ORDERING NOTE: tests share one provisioned child interp (building it is the +# expensive part - punk::ns/punk::lib/punk::ansi loads). Package registration +# is cumulative and -refresh increments the shared child's package epoch, so +# the -refresh re-scan test runs LAST. +# +# Run: tclsh src/tests/runtests.tcl -report compact -show-passes 0 -include-paths modules/punk/mix/** libsearch.test + +package require tcltest +package require punk::lib + +namespace eval ::testspace { + namespace import ::tcltest::* + + # ------------------------------------------------------------------------- + # Fixture tm tree (distinctive pklsr_ prefix so 'package names' deltas are + # unambiguous among the child's real loaded packages): + # fix/pklsr_topmod-1.0.tm, -1.1.tm (two versions) + # fix/pklsr_topsib-1.0.tm + # fix/pklsrns/leafmod-1.0.tm (pklsrns::leafmod) + # fix/pklsrns/leafsib-1.0.tm (pklsrns::leafsib) + # fix/pklsrns/subns/verydeep-1.0.tm (pklsrns::subns::verydeep) + # mut/pklsr_mtop-1.0.tm (mutation dir for epoch test) + # ------------------------------------------------------------------------- + variable fixture_error "" + variable fixdir "" + variable mutdir "" + try { + set base [punk::lib::tempdir_newfolder -prefix pklibsearch] + set fixdir [file join $base fix] + set mutdir [file join $base mut] + file mkdir [file join $fixdir pklsrns subns] $mutdir + foreach {relpath content} { + {pklsr_topmod-1.0.tm} {package provide pklsr_topmod 1.0} + {pklsr_topmod-1.1.tm} {package provide pklsr_topmod 1.1} + {pklsr_topsib-1.0.tm} {package provide pklsr_topsib 1.0} + {pklsrns/leafmod-1.0.tm} {package provide pklsrns::leafmod 1.0} + {pklsrns/leafsib-1.0.tm} {package provide pklsrns::leafsib 1.0} + {pklsrns/subns/verydeep-1.0.tm} {package provide pklsrns::subns::verydeep 1.0} + } { + set fd [open [file join $fixdir {*}[file split $relpath]] w] + puts $fd $content + close $fd + } + set fd [open [file join $mutdir pklsr_mtop-1.0.tm] w] + puts $fd {package provide pklsr_mtop 1.0} + close $fd + variable tempbase $base + } on error {result} { + set fixture_error $result + } + if {$fixture_error ne ""} { + puts stderr "libsearch.test fixture setup failed (tests will be skipped): $fixture_error" + } + + # ------------------------------------------------------------------------- + # Shared child interp: punk::libunknown active, loadedlib + its shell-env + # assumptions provided, then tm paths trimmed to the fixture dirs so + # searches and -refresh walks are deterministic and fast. + # ------------------------------------------------------------------------- + #The SOURCE-TREE punk::libunknown, located relative to this test file. + #A 'package require punk::libunknown' would tie-break the same-version (0.1) + #copies in src/modules and src/bootsupport/modules by tm path order - these + #tests need register_all_tm from the source copy, so it is sourced directly + #by path (as punk_main.tcl loads it). The other punk requires below are dev + #alpha versions (999999.0a1.0), which 'package prefer latest' selects + #deterministically regardless of tm path order. + variable libunknown_src "" + variable script_dir [file dirname [file normalize [info script]]] + set srcmodules [file normalize [file join $script_dir .. .. .. .. .. .. modules]] + set candidates [lsort [glob -nocomplain [file join $srcmodules punk libunknown-*.tm]]] + if {[llength $candidates]} { + set libunknown_src [lindex $candidates end] + } + + variable child "" + variable child_error "" + if {$fixture_error eq "" && $libunknown_src eq ""} { + set child_error "cannot locate src/modules/punk/libunknown-*.tm relative to [info script]" + puts stderr "libsearch.test: $child_error (tests will be skipped)" + } + if {$fixture_error eq "" && $child_error eq ""} { + try { + set child [interp create] + interp eval $child {package prefer latest} + interp eval $child {tcl::tm::remove {*}[tcl::tm::list]} + interp eval $child [list tcl::tm::add {*}[tcl::tm::list]] + interp eval $child [list set ::auto_path $::auto_path] + interp eval $child [list source $libunknown_src] + interp eval $child { + punk::libunknown::init + package require punk::mix::commandset::loadedlib + #punk::ansi pre-required only because the fixture-trimmed tm paths below + #cannot resolve it later; deliberately NO global a+/a aliases and NO + #punk::path - loadedlib 0.2.0 must not need the shell environment + package require punk::ansi + } + #trim search paths to the fixture: deterministic 'package names' + #deltas and fast -refresh walks / pkgIndex sweeps + interp eval $child {tcl::tm::remove {*}[tcl::tm::list]} + interp eval $child [list tcl::tm::add $fixdir $mutdir] + interp eval $child {set ::auto_path [list [info library]]} + #top-level scan: registers pklsr_topmod/pklsr_topsib/pklsr_mtop + #(sibling registration across all tm paths at root depth) + interp eval $child {package require pklsr_topmod} + } on error {result} { + set child_error $result + puts stderr "libsearch.test child interp setup failed (tests will be skipped): $child_error" + } + } + testConstraint searchchild [expr {$fixture_error eq "" && $child_error eq ""}] + + proc csearch {args} { + variable child + interp eval $child [list punk::mix::commandset::loadedlib::search -return list -highlight 0 {*}$args] + } + + #added 2026-07-11 (agent) - coverage prep for lib.search deep-discovery work (punk::mix::commandset::loadedlib) + + # -- match semantics ----------------------------------------------------------- + + test libsearch_substring_wrapped {a searchstring without glob chars is wrapped *name* (substring match)}\ + -constraints searchchild -body { + csearch sr_topsi + } -result {{pklsr_topsib 1.0}} + + test libsearch_versions_aggregated {all registered versions listed, vcompare-sorted}\ + -constraints searchchild -body { + csearch =pklsr_topmod + } -result {{pklsr_topmod {1.0 1.1}}} + + test libsearch_exact_prefix {=name searches exact - no wrapping, no partial match}\ + -constraints searchchild -body { + list [csearch =pklsr_topsib] [csearch =pklsr_topsi] + } -result {{{pklsr_topsib 1.0}} {}} + + test libsearch_case_insensitive_except_exact {non-exact search is nocase, =exact is case sensitive}\ + -constraints searchchild -body { + list [csearch PKLSR_TOPSIB] [csearch =PKLSR_TOPSIB] + } -result {{{pklsr_topsib 1.0}} {}} + + test libsearch_explicit_glob_not_wrapped {a searchstring containing glob chars is used as-is (anchored)}\ + -constraints searchchild -body { + list [lsort [lmap m [csearch pklsr_top*] {lindex $m 0}]] [csearch sr_top*] + } -result {{pklsr_topmod pklsr_topsib} {}} + + # -- highlight self-containment --------------------------------------------------- + + #added 2026-07-11 (agent) - pins the loadedlib 0.2.0 dependency fix: highlight uses + #qualified punk::ansi calls (no shell-global a+ alias exists in this child) + test libsearch_highlight_no_global_ansi_alias {-highlight 1 works without the shell-global a+ alias}\ + -constraints searchchild -body { + variable child + set r [interp eval $child [list punk::mix::commandset::loadedlib::search -return list -highlight 1 =pklsr_topmod]] + #pklsr_topmod 1.1 is loaded in the child - its version entry gets ansi-wrapped + list [llength $r] [string match "*pklsr_topmod*" $r] [string match "*\x1b*" $r] + } -result {1 1 1} + + # -- deep discovery / -refresh contract ------------------------------------------ + + #flipped 2026-07-11 (agent) from libsearch_GAP_default_misses_unscanned_deep_tm: + #deep discovery is now the default when punk::libunknown is active + test libsearch_default_deep_discovery {.tm modules at every namespace depth found without -refresh; registration persists}\ + -constraints searchchild -body { + #the second query pins that registration persists across searches + list [csearch leafsib] [csearch verydeep] + } -result {{{pklsrns::leafsib 1.0}} {{pklsrns::subns::verydeep 1.0}}} + + test libsearch_refresh_rescans_filesystem {default search misses .tm files added to already-scanned dirs (epoch cache); -refresh re-scans and finds them}\ + -constraints searchchild -body { + variable mutdir + #mut dir was scanned within the current epoch (deep discovery above); + #a module added on disk afterwards is behind the epoch index cache + set fd [open [file join $mutdir pklsr_newmod-1.0.tm] w] + puts $fd {package provide pklsr_newmod 1.0} + close $fd + set result [list] + lappend result [csearch sr_newmod] + #-refresh = package epoch incr + re-run discovery + lappend result [csearch -refresh sr_newmod] + } -result {{} {{pklsr_newmod 1.0}}} + + # cleanup + variable child + if {$child ne "" && [interp exists $child]} { + interp delete $child + } + variable tempbase + if {[info exists tempbase] && $tempbase ne "" && [file isdirectory $tempbase]} { + catch {file delete -force $tempbase} + } +} + +tcltest::cleanupTests +namespace delete ::testspace diff --git a/src/vfs/_vfscommon.vfs/modules/punk/libunknown-0.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/libunknown-0.1.tm index eca0df03..a119a618 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/libunknown-0.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/libunknown-0.1.tm @@ -81,6 +81,10 @@ tcl::namespace::eval ::punk::libunknown { }] variable epoch ;#don't set - can be pre-set cooperatively + variable tm_fullscan [dict create] ;#tm epochs fully scanned by register_all_tm. + #Deliberately interp-local (NOT part of the shareable epoch dict): 'package ifneeded' + #registrations are interp-local, so an interp receiving a shared epoch must still run + #its own registration pass (cheap - directory listings come from the shared index cache). variable has_package_files if {[catch {package files foobaz}]} { @@ -1195,6 +1199,157 @@ tcl::namespace::eval ::punk::libunknown { } } + namespace eval argdoc { + variable PUNKARGS + lappend PUNKARGS [list { + @id -id ::punk::libunknown::register_all_tm + @cmd -name punk::libunknown::register_all_tm\ + -summary\ + "Deep discovery: register ifneeded scripts for all .tm modules at every namespace depth."\ + -help\ + "Walks every path in tcl::tm::list recursively and registers a 'package ifneeded' + script for each .tm module found - including modules in namespace subfolders + that have never been requested. (The tm package unknown handler registers + sibling .tm files only at the namespace depth of the package being required, + so such modules are otherwise absent from 'package names' until first + requested.) + + Existing ifneeded scripts are never overridden - first registration wins, + matching the tm unknown handler, so head-of-tm-list precedence for + same-version modules is preserved. + + Uses and populates the same per-epoch directory index cache as the unknown + handlers: for zipfs (static) paths the whole tree listing is gathered in one + call; for filesystem paths each directory's *.tm glob is cached per + 'package epoch'. Directories named #modpod-*, #tarjar-* and _build are + skipped. + + The scan runs at most once per tm epoch per interp (tracked in the + interp-local tm_fullscan variable - deliberately not part of the shareable + epoch dict, because ifneeded registrations are interp-local; an interp + receiving a shared epoch re-registers cheaply from the cached indexes). + Path-list changes and 'package epoch incr' start a new tm epoch, + re-enabling the scan - a call after 'package epoch incr' re-reads the + filesystem and picks up modules added or removed on disk. + + Returns a stats dict: epoch, roots, dirs, tmfiles, registered - plus + 'cached 1' when the call was a per-epoch no-op. + + punk::libunknown::init must have been called first." + @opts + -force -type none -help\ + "Run the registration pass even if already performed in the current tm epoch. + Directory listings still come from the epoch index cache where present - + use 'package epoch incr' first to force re-reading the filesystem." + }] + } + proc register_all_tm {args} { + variable epoch + if {![info exists epoch]} { + error "punk::libunknown::register_all_tm - punk::libunknown::init has not been called in this interp" + } + set opt_force [expr {"-force" in $args}] + variable tm_fullscan + set tm_epoch [dict get $epoch tm current] + if {!$opt_force && [dict exists $tm_fullscan $tm_epoch]} { + return [dict merge [dict get $tm_fullscan $tm_epoch] [dict create cached 1]] + } + upvar ::tcl::tm::paths paths + upvar ::tcl::tm::pkgpattern pkgpattern + + if {[info commands ::tcl::zipfs::root] ne ""} { + set zipfsroot [tcl::zipfs::root] + set has_zipfs 1 + } else { + set zipfsroot "//zipfs:/" ;#doesn't matter much what we use here - don't expect in tm list if no zipfs commands + set has_zipfs 0 + } + set stat_roots 0 + set stat_dirs 0 + set stat_files 0 + set stat_registered 0 + foreach path $paths { + if {![interp issafe] && ![file exists $path]} { + continue + } + incr stat_roots + set tmfiles [list] + if {$has_zipfs && [string match $zipfsroot* $path]} { + #static filesystem - the whole tm tree is available in one quick call + #(as the tm unknown handler's zipfs branch does) + set tmfiles [::tcl::zipfs::list $path/*.tm] + set seen_dirs [dict create] + foreach tm_path $tmfiles { + set d [file dirname $tm_path] + dict set seen_dirs $d 1 + dict set epoch tm epochs $tm_epoch indexes $d $tm_path $tm_epoch + } + incr stat_dirs [dict size $seen_dirs] + } else { + #plain filesystem - breadth-first walk, reusing/populating the per-epoch + #directory index cache so the unknown handlers can short-circuit later + set pending [list $path] + while {[llength $pending]} { + set current [lindex $pending 0] + set pending [lrange $pending 1 end] + incr stat_dirs + if {[dict exists $epoch tm epochs $tm_epoch indexes $current]} { + set dirfiles [dict keys [dict get $epoch tm epochs $tm_epoch indexes $current]] + } else { + set dirfiles [glob -nocomplain -directory $current -types f *.tm] + dict set epoch tm epochs $tm_epoch indexes $current [dict create] + foreach f $dirfiles { + dict set epoch tm epochs $tm_epoch indexes $current $f $tm_epoch + } + } + lappend tmfiles {*}$dirfiles + foreach sub [glob -nocomplain -directory $current -types d *] { + set tail [file tail $sub] + if {[string match "#modpod-*" $tail] || [string match "#tarjar-*" $tail] || $tail eq "_build"} { + continue + } + lappend pending $sub + } + } + } + #registration - same rules as the tm unknown handler (don't override existing + #ifneeded scripts: for tm modules the first encountered 'wins') + set strip [llength [file split $path]] + foreach file $tmfiles { + if {[string match "*/_build/*" $file]} { + continue + } + incr stat_files + set pkgfilename [join [lrange [file split $file] $strip end] ::] + if {![regexp -- $pkgpattern $pkgfilename --> pkgname pkgversion]} { + # Ignore everything not matching our pattern for package names. + continue + } + try { + package vcompare $pkgversion 0 + } on error {} { + # Ignore everything where the version part is not acceptable to + # "package vcompare". + continue + } + if {([package ifneeded $pkgname $pkgversion] ne {}) && (![interp issafe])} { + #already registered - possibly by an earlier (higher precedence) path + dict set epoch tm epochs $tm_epoch added $path $pkgname $pkgversion e$tm_epoch + dict unset epoch tm untracked $pkgname + continue + } + package ifneeded $pkgname $pkgversion \ + "[::list package provide $pkgname $pkgversion];[::list source $file]" + incr stat_registered + dict set epoch tm epochs $tm_epoch added $path $pkgname $pkgversion e$tm_epoch + dict unset epoch tm untracked $pkgname + } + } + set stats [dict create epoch $tm_epoch roots $stat_roots dirs $stat_dirs tmfiles $stat_files registered $stat_registered] + dict set tm_fullscan $tm_epoch $stats + return $stats + } + #see what basic info we can gather *quickly* about the indexes for each version of a pkg that the package db knows about. #we want no calls out to the actual filesystem - but we can use some 'file' calls such as 'file dirname', 'file split' (review -safe interp problem) #in practice the info is only available for tm modules diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.2.0.tm similarity index 84% rename from src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.1.0.tm rename to src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.2.0.tm index a07aca09..056f243e 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.2.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::mix::commandset::loadedlib 0.1.0 +# Application punk::mix::commandset::loadedlib 0.2.0 # Meta platform tcl # Meta license # @@ Meta End @@ -28,13 +28,37 @@ namespace eval punk::mix::commandset::loadedlib { #search automatically wrapped in * * - can contain inner * ? globs punk::args::define { @id -id ::punk::mix::commandset::loadedlib::search - @cmd -name "punk::mix::commandset::loadedlib search" -help "search all Tcl libraries available to your local interpreter" + @cmd -name "punk::mix::commandset::loadedlib search" -help\ + "search all Tcl libraries available to your local interpreter. + When punk::libunknown is active (the punkshell default) a deep module + discovery pass runs first, so .tm modules at every namespace depth are + included - cached per 'package epoch', repeat searches are cheap. + See -refresh for cache/re-scan details." -return -type string -default table -choices {table tableobject list lines} -present -type integer -default 2 -choices {0 1 2} -choicelabels {absent present both} -help\ "(unimplemented) Display only those that are 0:absent 1:present 2:either" -highlight -type boolean -default 1 -help\ "Highlight which version is present with ansi underline and colour" - -refresh -type none -help "Re-scan the tm and library folders" + -refresh -type none -help\ + "Force a genuine filesystem re-scan of the module and library folders. + When punk::libunknown is active (the punkshell default), every search + already performs a deep module discovery pass - registering .tm modules + at every namespace depth across all tcl::tm::list paths (see + punk::libunknown::register_all_tm) - cached per 'package epoch' so + repeat searches are cheap. Because directories already indexed in the + current epoch are not re-globbed, that default pass does not notice .tm + files added to (or removed from) already-scanned folders. + -refresh increments the package epoch ('package epoch incr'), + invalidating the scan caches, then re-runs discovery - picking up + on-disk changes and re-sourcing the pkgIndex.tcl files on ::auto_path. + Changes to tcl::tm::list or ::auto_path increment the epoch + automatically (via variable traces) - this flag is not needed for + those cases. + When punk::libunknown is not active there is no epoch cache: the + default search reflects only packages already registered in the + package database, and -refresh performs the (comparatively expensive) + deep discovery walk directly using dummy package require calls at + each namespace depth." searchstring -default * -multiple 1 -help\ "Names to search for, may contain glob chars (* ?) e.g *lib* If no glob chars are explicitly specified, the searchstring will be wrapped with star globs. @@ -51,19 +75,47 @@ namespace eval punk::mix::commandset::loadedlib { set opt_highlight [dict get $opts -highlight] set opt_refresh [dict exists $received -refresh] - if {$opt_refresh} { - catch {package require frobznodule666} ;#ensure pkg system has loaded/searched for everything REVIEW - this doesn't result in full scans - foreach tm_path [tcl::tm::list] { - set paths_below [punk::path::subfolders -recursive $tm_path] - foreach folder $paths_below { - set tail [file tail $folder] - if {[string match #modpod-* $tail] || [string match #tarjar-* $tail]} { - continue + #Deep discovery of available packages. + #The package unknown handlers register .tm siblings only at the namespace depth + #being requested - modules in never-requested subfolders are absent from + #'package names' until a deep pass registers them. + #Note: ::info must be fully qualified here - this namespace defines its own 'info' proc + if {[::info commands ::punk::libunknown::register_all_tm] ne "" && [::info exists ::punk::libunknown::epoch]} { + if {$opt_refresh} { + #genuine filesystem re-scan: start a new package epoch so the scan + #caches are invalidated (pkgIndex.tcl files on ::auto_path will also be + #re-sourced by the dummy require below) + package epoch incr + } + #register .tm modules at every namespace depth (cached per tm epoch - + #repeat searches are cheap) + punk::libunknown::register_all_tm + #sweep the pkgIndex.tcl files of ::auto_path for library-style packages + catch {package require frobznodule666} + } else { + #punk::libunknown deep registration unavailable - without its epoch cache a + #recursive walk on every search would be expensive, so deep discovery runs + #only on explicit request. + if {$opt_refresh} { + if {[::info exists ::punk::libunknown::epoch]} { + #older punk::libunknown without register_all_tm: invalidate its scan + #caches so the dummy requires below re-read the filesystem + catch {package epoch incr} + } + catch {package require frobznodule666} ;#top-level tm scan + pkgIndex sweep of ::auto_path + package require punk::path + foreach tm_path [tcl::tm::list] { + set paths_below [punk::path::subfolders -recursive $tm_path] + foreach folder $paths_below { + set tail [file tail $folder] + if {[string match #modpod-* $tail] || [string match #tarjar-* $tail]} { + continue + } + if {[string match */_build/* $folder]} {continue} + set relpath [string tolower [punk::path::relative $tm_path $folder]] + set modpath [string map {/ ::} $relpath] + catch {package require ${modpath}::flobrudder99} } - if {[string match */_build/* $folder]} {continue} - set relpath [string tolower [punk::path::relative $tm_path $folder]] - set modpath [string map {/ ::} $relpath] - catch {package require ${modpath}::flobrudder99} } } } @@ -85,8 +137,12 @@ namespace eval punk::mix::commandset::loadedlib { } set matches [lsort -unique $matches] set matchinfo [list] - set highlight_ansi [a+ web-limegreen underline] - set RST [a] + if {$opt_highlight} { + #not a module-top require: punk::ansi is only needed for highlighting + package require punk::ansi + set highlight_ansi [punk::ansi::a+ web-limegreen underline] + set RST [punk::ansi::a] + } foreach m $matches { set versions [package versions $m] if {![llength $versions]} { @@ -122,6 +178,7 @@ namespace eval punk::mix::commandset::loadedlib { return [join $matchinfo \n] } table - tableobject { + package require textblock set t [textblock::class::table new] $t add_column -headers "Package" $t add_column -headers "Version" @@ -601,6 +658,6 @@ namespace eval punk::mix::commandset::loadedlib { ## Ready package provide punk::mix::commandset::loadedlib [namespace eval punk::mix::commandset::loadedlib { variable version - set version 0.1.0 + set version 0.2.0 }] return