Browse Source
Root AGENTS.md closeout now includes a step to re-check modified .tm files for new procs lacking PUNKARGS argdoc blocks. src/modules/AGENTS.md Work Guidance explicitly requires argdoc blocks for all new procs in .tm files (documentation-only is acceptable). The Documentation section clarifies that 'user-facing' includes developer-facing utility procs. A new 'Argument Order In PUNKARGS' section explains the distinction between @leaders, @opts, and @values and why putting a leading argument in @values produces an incorrect synopsis. Verification section adds a check for PUNKARGS argdoc blocks on new procs. The interp_sync.test file contains 6 tcltest tests for the new punk::lib helper procs.master
3 changed files with 181 additions and 2 deletions
@ -0,0 +1,165 @@
|
||||
package require tcltest |
||||
package require punk::lib |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
# -------------------------------------------------------------------------- |
||||
# Test 1: Basic propagation — tm list, auto_path, package prefer |
||||
# -------------------------------------------------------------------------- |
||||
test interp_sync_basic {interp_sync_package_paths propagates tm list, auto_path, and package prefer to child interp}\ |
||||
-setup { |
||||
set saved_prefer [package prefer] |
||||
package prefer latest |
||||
set child [interp create] |
||||
}\ |
||||
-body { |
||||
punk::lib::interp_sync_package_paths $child |
||||
set result [list] |
||||
lappend result [expr {[interp eval $child {tcl::tm::list}] eq [tcl::tm::list]}] |
||||
lappend result [expr {[interp eval $child {set ::auto_path}] eq $::auto_path}] |
||||
lappend result [interp eval $child {package prefer}] |
||||
return $result |
||||
}\ |
||||
-cleanup { |
||||
interp delete $child |
||||
package prefer $saved_prefer |
||||
}\ |
||||
-result {1 1 latest} |
||||
|
||||
# -------------------------------------------------------------------------- |
||||
# Test 2: package prefer latest enables alpha version selection in child |
||||
# -------------------------------------------------------------------------- |
||||
test interp_sync_prefer_latest_version {package prefer latest propagated to child enables alpha version selection}\ |
||||
-setup { |
||||
set saved_prefer [package prefer] |
||||
package prefer latest |
||||
namespace eval ::testsynthpkg {} |
||||
package ifneeded testsynthpkg 0.1.1 {package provide testsynthpkg 0.1.1} |
||||
package ifneeded testsynthpkg 999999.0a1.0 {package provide testsynthpkg 999999.0a1.0} |
||||
set child [interp create] |
||||
punk::lib::interp_sync_package_paths $child |
||||
#register both versions in child |
||||
interp eval $child {namespace eval ::testsynthpkg {}} |
||||
interp eval $child [list package ifneeded testsynthpkg 0.1.1 {package provide testsynthpkg 0.1.1}] |
||||
interp eval $child [list package ifneeded testsynthpkg 999999.0a1.0 {package provide testsynthpkg 999999.0a1.0}] |
||||
}\ |
||||
-body { |
||||
interp eval $child {package require testsynthpkg} |
||||
}\ |
||||
-cleanup { |
||||
interp delete $child |
||||
package forget testsynthpkg |
||||
package prefer $saved_prefer |
||||
}\ |
||||
-result {999999.0a1.0} |
||||
|
||||
# -------------------------------------------------------------------------- |
||||
# Test 3: Ordering preservation — tm list and auto_path must match exactly |
||||
# -------------------------------------------------------------------------- |
||||
test interp_sync_ordering {tm list and auto_path ordering preserved exactly in child interp}\ |
||||
-setup { |
||||
set child [interp create] |
||||
}\ |
||||
-body { |
||||
punk::lib::interp_sync_package_paths $child |
||||
set parent_tm [tcl::tm::list] |
||||
set child_tm [interp eval $child {tcl::tm::list}] |
||||
set parent_ap $::auto_path |
||||
set child_ap [interp eval $child {set ::auto_path}] |
||||
#compare element-by-element |
||||
set tm_match [expr {[llength $parent_tm] == [llength $child_tm]}] |
||||
for {set i 0} {$tm_match && $i < [llength $parent_tm]} {incr i} { |
||||
if {[lindex $parent_tm $i] ne [lindex $child_tm $i]} { |
||||
set tm_match 0 |
||||
} |
||||
} |
||||
set ap_match [expr {[llength $parent_ap] == [llength $child_ap]}] |
||||
for {set i 0} {$ap_match && $i < [llength $parent_ap]} {incr i} { |
||||
if {[lindex $parent_ap $i] ne [lindex $child_ap $i]} { |
||||
set ap_match 0 |
||||
} |
||||
} |
||||
return [list $tm_match $ap_match] |
||||
}\ |
||||
-cleanup { |
||||
interp delete $child |
||||
}\ |
||||
-result {1 1} |
||||
|
||||
# -------------------------------------------------------------------------- |
||||
# Test 4: snapshot_package_paths returns a valid script string |
||||
# -------------------------------------------------------------------------- |
||||
test snapshot_package_paths_valid {snapshot_package_paths returns a script that reproduces state when eval'd in child}\ |
||||
-setup { |
||||
set saved_prefer [package prefer] |
||||
package prefer latest |
||||
set child [interp create] |
||||
}\ |
||||
-body { |
||||
set script [punk::lib::snapshot_package_paths] |
||||
#verify the script is non-empty and contains key commands |
||||
set has_tm [expr {[string first "tcl::tm::add" $script] >= 0}] |
||||
set has_ap [expr {[string first "set ::auto_path" $script] >= 0}] |
||||
set has_prefer [expr {[string first "package prefer" $script] >= 0}] |
||||
#eval in child and verify state matches |
||||
interp eval $child $script |
||||
set tm_match [expr {[interp eval $child {tcl::tm::list}] eq [tcl::tm::list]}] |
||||
set ap_match [expr {[interp eval $child {set ::auto_path}] eq $::auto_path}] |
||||
set prefer_match [expr {[interp eval $child {package prefer}] eq [package prefer]}] |
||||
return [list $has_tm $has_ap $has_prefer $tm_match $ap_match $prefer_match] |
||||
}\ |
||||
-cleanup { |
||||
interp delete $child |
||||
package prefer $saved_prefer |
||||
}\ |
||||
-result {1 1 1 1 1 1} |
||||
|
||||
# -------------------------------------------------------------------------- |
||||
# Test 5: -libunknown 1 sets up epoch and package unknown handler in child |
||||
# -------------------------------------------------------------------------- |
||||
test interp_sync_libunknown {-libunknown 1 sets up punk::libunknown epoch and custom package unknown in child}\ |
||||
-setup { |
||||
set child [interp create] |
||||
}\ |
||||
-body { |
||||
punk::lib::interp_sync_package_paths $child -libunknown 1 |
||||
set result [list] |
||||
#epoch should exist in child |
||||
lappend result [interp eval $child {info exists ::punk::libunknown::epoch}] |
||||
#package unknown should be set to libunknown's handler (not default) |
||||
set unknown_handler [interp eval $child {package unknown}] |
||||
lappend result [expr {[string first "punk::libunknown" $unknown_handler] >= 0}] |
||||
return $result |
||||
}\ |
||||
-cleanup { |
||||
interp delete $child |
||||
}\ |
||||
-result {1 1} |
||||
|
||||
# -------------------------------------------------------------------------- |
||||
# Test 6: Regression — existing interp_sync_package_paths without -libunknown |
||||
# -------------------------------------------------------------------------- |
||||
test interp_sync_regression {interp_sync_package_paths without -libunknown still propagates auto_path, tm list, and package prefer}\ |
||||
-setup { |
||||
set saved_prefer [package prefer] |
||||
package prefer latest |
||||
set child [interp create] |
||||
}\ |
||||
-body { |
||||
punk::lib::interp_sync_package_paths $child |
||||
set result [list] |
||||
lappend result [expr {[interp eval $child {set ::auto_path}] eq $::auto_path}] |
||||
lappend result [expr {[interp eval $child {tcl::tm::list}] eq [tcl::tm::list]}] |
||||
lappend result [interp eval $child {package prefer}] |
||||
return $result |
||||
}\ |
||||
-cleanup { |
||||
interp delete $child |
||||
package prefer $saved_prefer |
||||
}\ |
||||
-result {1 1 latest} |
||||
|
||||
} |
||||
|
||||
tcltest::cleanupTests |
||||
Loading…
Reference in new issue