From d9ea04ecb3b3e0f2c5cd3cd6db54907acd218c46 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Sat, 4 Jul 2026 20:10:15 +1000 Subject: [PATCH] punk::lib 0.2.0: add snapshot_package_paths + extend interp_sync_package_paths with package prefer and -libunknown flag snapshot_package_paths returns a script string reproducing the caller's tcl::tm::list, auto_path, and package prefer for use in thread::create init scripts. With -libunknown 1 it also copies the punk::libunknown epoch and sources+inits libunknown in the target. interp_sync_package_paths now propagates package prefer (was missing) and accepts optional -libunknown 1 flag for epoch copy + libunknown init in the child interp. Both procs have PUNKARGS argdoc documentation. Includes 6 tcltest tests covering basic propagation, version selection with package prefer latest, ordering preservation, snapshot script validity, -libunknown flag, and regression. --- src/modules/punk/lib-999999.0a1.0.tm | 205 +++++++++++++++++++++++++- src/modules/punk/lib-buildversion.txt | 4 +- 2 files changed, 207 insertions(+), 2 deletions(-) diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index 51d58f39..e674a11d 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/src/modules/punk/lib-999999.0a1.0.tm @@ -8106,13 +8106,216 @@ namespace eval punk::lib { return [expr {($deg_celsius * (9/5.0)) + 32}] } - proc interp_sync_package_paths {interp} { + namespace eval argdoc { + variable PUNKARGS + lappend PUNKARGS [list { + @id -id ::punk::lib::snapshot_package_paths + @cmd -name punk::lib::snapshot_package_paths\ + -summary\ + "Return a script string that reproduces the caller's package loading state in a new interp or thread."\ + -help\ + "Captures the caller's tcl::tm::list (ordered), ::auto_path (ordered), and package prefer + setting and returns a script string that, when evaluated in a new interpreter or thread + init script, reproduces the same package search paths and version preference. + + This is intended for use in thread::create init scripts and interp eval calls where + a child interp or thread needs to inherit the parent's package resolution state. + + With -libunknown 1, the script also copies the punk::libunknown epoch dict and + sources+inits punk::libunknown in the target, so the child gets the same custom + package unknown handler and scan cache as the parent. This avoids re-scanning + all module and library paths on every package require in the child. + + The returned script uses only Tcl builtins (tcl::tm, set, package) and does not + require any punk packages to be loaded in the target — except when -libunknown 1 + is used, in which case punk::libunknown is sourced from the tm paths that were + already set up by the earlier part of the script. + + See also: punk::lib::interp_sync_package_paths" + @opts + -libunknown -type boolean -default 0 -help\ + "If 1, the script also sets up punk::libunknown in the target: copies the epoch + dict, finds and sources libunknown-*.tm from the tm paths, and calls + punk::libunknown::init. The child inherits the parent's scan cache and + custom package unknown handler." + }] + } + proc snapshot_package_paths {args} { + #Returns a script string that reproduces the caller's tcl::tm::list, + #auto_path, and package prefer state in a new interp or thread. + #Optional -libunknown 1 also includes punk::libunknown epoch copy + init. + set do_libunknown 0 + for {set i 0} {$i < [llength $args]} {incr i} { + set arg [lindex $args $i] + switch -- $arg { + -libunknown { + set do_libunknown 1 + incr i + #value is 0 or 1 + if {$i < [llength $args]} { + set do_libunknown [lindex $args $i] + } + } + default { + error "snapshot_package_paths: unknown option '$arg'" + } + } + } + set tmlist [tcl::tm::list] + set ap $::auto_path + set prefer [package prefer] + set script "" + append script "tcl::tm::remove \{*\}\[tcl::tm::list\]\n" + append script "tcl::tm::add \{*\}\[list [lreverse $tmlist]\]\n" + append script "set ::auto_path \[list $ap\]\n" + append script "package prefer $prefer\n" + if {$do_libunknown} { + if {[info exists ::punk::libunknown::epoch]} { + append script "namespace eval ::punk::libunknown {}\n" + append script "set ::punk::libunknown::epoch [list $::punk::libunknown::epoch]\n" + } + #find and source libunknown, then call init + append script { + apply {{} { + set libunks [list] + foreach tm_path [tcl::tm::list] { + set punkdir [file join $tm_path punk] + if {![file exists $punkdir]} {continue} + lappend libunks {*}[glob -nocomplain -dir $punkdir -type f libunknown-*.tm] + } + set libunknown "" + set libunknown_version_sofar "" + foreach lib $libunks { + set vtail [lindex [split [file tail $lib] -] 1] + set thisver [file rootname $vtail] + if {$libunknown_version_sofar eq ""} { + set libunknown_version_sofar $thisver + set libunknown $lib + } else { + if {[package vcompare $thisver $libunknown_version_sofar] == 1} { + set libunknown_version_sofar $thisver + set libunknown $lib + } + } + } + if {$libunknown ne ""} { + uplevel 1 [list source $libunknown] + if {[catch {punk::libunknown::init -caller "snapshot_package_paths"} errM]} { + puts stderr "snapshot_package_paths: error initialising punk::libunknown\n$errM" + } + } + }} + } + append script "\n" + } + return $script + } + + namespace eval argdoc { + variable PUNKARGS + lappend PUNKARGS [list { + @id -id ::punk::lib::interp_sync_package_paths + @cmd -name punk::lib::interp_sync_package_paths\ + -summary\ + "Propagate the caller's tcl::tm::list, auto_path, and package prefer to a child interpreter."\ + -help\ + "Synchronises a child interpreter's package search paths and version preference + to match the caller's state. The child interp must already exist (create it first + with [interp create] or [interp create -safe]). + + This propagates: + - tcl::tm::list (ordered — same priority ordering as parent) + - ::auto_path (ordered) + - package prefer (e.g 'latest' or 'stable') + + With -libunknown 1, also copies the punk::libunknown epoch dict to the child + and sources+inits punk::libunknown there, giving the child the same custom + package unknown handler and scan cache as the parent. This is recommended + when the child will do significant package loading. + + This is an opt-in helper — call sites that don't use it keep their current + behavior. It does not load packages, install punk::packagepreference, share + channels, or configure safe-interp restrictions — those remain caller + responsibilities. + + See also: punk::lib::snapshot_package_paths" + @leaders + interp -type string -help\ + "Name of the child interpreter to synchronise. Must already exist." + @opts + -libunknown -type boolean -default 0 -help\ + "If 1, also copy punk::libunknown epoch, source libunknown-*.tm in the child, + and call punk::libunknown::init so the child inherits the parent's scan + cache and custom package unknown handler." + }] + } + proc interp_sync_package_paths {interp args} { if {![interp exists $interp]} { error "interp_sync_package_paths error. interp '$interp' not found. Create it first with \[interp create $interp\]" } + set do_libunknown 0 + for {set i 0} {$i < [llength $args]} {incr i} { + set arg [lindex $args $i] + switch -- $arg { + -libunknown { + set do_libunknown 1 + incr i + if {$i < [llength $args]} { + set do_libunknown [lindex $args $i] + } + } + default { + error "interp_sync_package_paths: unknown option '$arg'" + } + } + } + #basic propagation: tm list, auto_path, package prefer interp eval $interp [list set ::auto_path $::auto_path] interp eval $interp {tcl::tm::remove {*}[tcl::tm::list]} interp eval $interp [list tcl::tm::add {*}[lreverse [tcl::tm::list]]] + interp eval $interp [list package prefer [package prefer]] + #extended: copy epoch + source libunknown + call init + if {$do_libunknown} { + if {[info exists ::punk::libunknown::epoch]} { + interp eval $interp {namespace eval ::punk::libunknown {}} + interp eval $interp [list set ::punk::libunknown::epoch $::punk::libunknown::epoch] + } + #use snapshot's libunknown sourcing logic via interp eval + set libunknown_script [punk::lib::snapshot_package_paths -libunknown 1] + #extract just the libunknown sourcing part (after the basic propagation) + #we already did basic propagation above, so only run the libunknown init part + interp eval $interp { + apply {{} { + set libunks [list] + foreach tm_path [tcl::tm::list] { + set punkdir [file join $tm_path punk] + if {![file exists $punkdir]} {continue} + lappend libunks {*}[glob -nocomplain -dir $punkdir -type f libunknown-*.tm] + } + set libunknown "" + set libunknown_version_sofar "" + foreach lib $libunks { + set vtail [lindex [split [file tail $lib] -] 1] + set thisver [file rootname $vtail] + if {$libunknown_version_sofar eq ""} { + set libunknown_version_sofar $thisver + set libunknown $lib + } else { + if {[package vcompare $thisver $libunknown_version_sofar] == 1} { + set libunknown_version_sofar $thisver + set libunknown $lib + } + } + } + if {$libunknown ne ""} { + uplevel 1 [list source $libunknown] + if {[catch {punk::libunknown::init -caller "interp_sync_package_paths"} errM]} { + puts stderr "interp_sync_package_paths: error initialising punk::libunknown\n$errM" + } + } + }} + } + } } proc valcopy {obj} { diff --git a/src/modules/punk/lib-buildversion.txt b/src/modules/punk/lib-buildversion.txt index a969a498..c0497672 100644 --- a/src/modules/punk/lib-buildversion.txt +++ b/src/modules/punk/lib-buildversion.txt @@ -1,3 +1,5 @@ -0.1.6 +0.2.0 #First line must be a semantic version number #all other lines are ignored. +#0.2.0 - new: snapshot_package_paths proc returns a script string reproducing tm list, auto_path, and package prefer for use in thread::create init scripts +#0.2.0 - extended: interp_sync_package_paths now propagates package prefer and supports optional -libunknown 1 flag for epoch copy + libunknown init