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