Browse Source
Groundwork requested for the future rework of n/ n// n/// output to punk tables with terminal-width responsiveness: the underlying display elements and navigation/retention semantics are now pinned so only deliberately REWORK-flagged pins flip when the layout changes. - punk/ns nslist.test (11): tier A pins get_ns_dicts classification buckets (the machine contract: children/packagetails/packageprefixes per the package-names derivation, commands/exported/imported/aliases/procs/ ensembles/oo/coroutines/usageinfo incl alias-target doc resolution and its update_definitions dependence, alias edge cases, native via builtin ns); tier B pins per-element marking layout-agnostically (underline/underdouble/ underdotted package styles, type tag colours, exported green / imported -I under overtype SGR canonicalization, the punkargs doc icon); tier C pins the CURRENT hardcoded 2-col/4-col layout and nspath subtables, explicitly flagged to flip with the rework; KNOWN QUIRK pinned: bare nslist without -types errors with a malformed message (literal dollar-known_types). Findings recorded: the red-strike/masked alias display branches appear unreachable from current bucket derivation. - punk/nav/ns navns.test (6, new suite dir): ns/ navigation state machine (absolute/relative/glob-no-nav/failed-nav preservation/quad-colon normalization), v-form content selection, ensemble annotation, and the ::punk::nav::ns::ns_current variable contract. - punk/repl nscurrent.test (4): repl retention proven against a REAL codethread (repl::init, synchronous runscript sends): inscope evaluation, retention across submissions, n/ navigation retained, auto-create-with- notice for a missing current namespace. - punk::repl 0.5.2 fix: repl::start''s codethread seeding template namespace-eval''d the full ns_current VARIABLE name, creating a stray namespace of that name in every code interp (phantom child in n/ listings of the nav namespace). Now ensures only the parent ::punk::nav::ns. Subshell namespace carry-over semantics unchanged; pinned behaviourally (mirrored template) plus a source-text guard, pending the planned end-to-end piped subshell test (E3) at the shell level. Verified: punk/ns 80/80, punk/nav 6/6, punk/repl 7/7 under Tcl 9.0.3; nslist/navns/nscurrent green under 8.7. Console queries mocked throughout (the render path consults get_size/get_tabstops). Project 0.12.33 + CHANGELOG; tests AGENTS.md index updated. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
8 changed files with 724 additions and 4 deletions
@ -1,4 +1,4 @@
|
||||
[project] |
||||
name = "punkshell" |
||||
version = "0.12.32" |
||||
version = "0.12.33" |
||||
license = "BSD-2-Clause" |
||||
|
||||
@ -0,0 +1,172 @@
|
||||
package require tcltest |
||||
|
||||
package require punk::ns ;#punk::nav::ns expects punk::ns machinery present |
||||
package require punk::ansi |
||||
package require punk::nav::ns |
||||
package require punk::console |
||||
|
||||
#added 2026-07-14 (agent) - punk::nav::ns::ns/ navigation semantics (the n/ n// n/// |
||||
#shell commands are aliases of this with v inferred). Display content is |
||||
#characterized in punk/ns testsuites/ns/nslist.test - this suite covers the |
||||
#NAVIGATION state machine and the repl coupling contract. |
||||
# |
||||
#Repl coupling (pinned below): the repl evaluates every submitted script |
||||
#tcl::namespace::inscope $::punk::nav::ns::ns_current (punk::repl::codethread |
||||
#runscript), and repl::start seeds a new codethread's code interp from the |
||||
#launching context's ns_current when it exists (the subshell namespace carry-over). |
||||
#Those integration behaviours are covered at the repl/shell level - here we pin |
||||
#the variable contract they all share: navigation means mutating |
||||
#::punk::nav::ns::ns_current and nothing else. |
||||
# |
||||
#Console queries are mocked (renderline.test pattern) - ns/ renders its listing |
||||
#via punk::ns::nslist (overtype/textblock pipeline). |
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
proc mock_console {} { |
||||
if {[llength [info commands ::punk::console::get_tabstops]]} { |
||||
rename ::punk::console::get_tabstops ::testspace::__orig_get_tabstops |
||||
} |
||||
proc ::punk::console::get_tabstops {{inoutchannels {stdin stdout}}} { |
||||
set stops {} |
||||
for {set c 9} {$c <= 201} {incr c 8} {lappend stops $c} |
||||
return $stops |
||||
} |
||||
if {[llength [info commands ::punk::console::get_size]]} { |
||||
rename ::punk::console::get_size ::testspace::__orig_get_size |
||||
} |
||||
proc ::punk::console::get_size {args} { |
||||
return [dict create columns 80 rows 24] |
||||
} |
||||
} |
||||
proc restore_console {} { |
||||
catch {rename ::punk::console::get_tabstops {}} |
||||
if {[llength [info commands ::testspace::__orig_get_tabstops]]} { |
||||
rename ::testspace::__orig_get_tabstops ::punk::console::get_tabstops |
||||
} |
||||
catch {rename ::punk::console::get_size {}} |
||||
if {[llength [info commands ::testspace::__orig_get_size]]} { |
||||
rename ::testspace::__orig_get_size ::punk::console::get_size |
||||
} |
||||
} |
||||
variable navsetup { |
||||
set result "" |
||||
::testspace::mock_console |
||||
#minimal fixture tree for navigation |
||||
namespace eval ::navtree { |
||||
proc here {} {return here} |
||||
namespace eval childa { |
||||
proc inchild {} {return inchild} |
||||
namespace eval deeper {} |
||||
} |
||||
namespace eval childb {} |
||||
namespace eval enschild { |
||||
namespace export dothing |
||||
proc dothing {} {return done} |
||||
namespace ensemble create |
||||
} |
||||
} |
||||
variable saved_ns_current $::punk::nav::ns::ns_current |
||||
} |
||||
variable navcleanup { |
||||
variable saved_ns_current |
||||
set ::punk::nav::ns::ns_current $saved_ns_current |
||||
catch {namespace delete ::navtree} |
||||
::testspace::restore_console |
||||
} |
||||
|
||||
|
||||
test navns_ns_current_contract {navigation state lives in ::punk::nav::ns::ns_current (the variable the repl and subshell seeding consume)}\ |
||||
-setup $navsetup -body { |
||||
lappend result [info exists ::punk::nav::ns::ns_current] |
||||
set ::punk::nav::ns::ns_current :: |
||||
punk::nav::ns::ns/ / ::navtree |
||||
lappend result $::punk::nav::ns::ns_current |
||||
}\ |
||||
-cleanup $navcleanup\ |
||||
-result [list\ |
||||
1 ::navtree |
||||
] |
||||
|
||||
test navns_transitions {absolute and relative non-glob targets navigate; glob targets list without navigating}\ |
||||
-setup $navsetup -body { |
||||
set ::punk::nav::ns::ns_current :: |
||||
punk::nav::ns::ns/ / ::navtree |
||||
lappend result $::punk::nav::ns::ns_current |
||||
punk::nav::ns::ns/ / childa |
||||
lappend result $::punk::nav::ns::ns_current |
||||
punk::nav::ns::ns/ / deeper |
||||
lappend result $::punk::nav::ns::ns_current |
||||
#glob pattern - lists matches, does NOT change ns_current |
||||
set ::punk::nav::ns::ns_current ::navtree |
||||
punk::nav::ns::ns/ / child* |
||||
lappend result $::punk::nav::ns::ns_current |
||||
}\ |
||||
-cleanup $navcleanup\ |
||||
-result [list\ |
||||
::navtree\ |
||||
::navtree::childa\ |
||||
::navtree::childa::deeper\ |
||||
::navtree |
||||
] |
||||
|
||||
test navns_failed_navigation_preserves_state {navigating to a nonexistent namespace errors and leaves ns_current unchanged}\ |
||||
-setup $navsetup -body { |
||||
set ::punk::nav::ns::ns_current ::navtree |
||||
lappend result [catch {punk::nav::ns::ns/ / ::navtree::nosuchns} msg] |
||||
lappend result $msg |
||||
lappend result $::punk::nav::ns::ns_current |
||||
lappend result [catch {punk::nav::ns::ns/ / alsonosuch}] |
||||
lappend result $::punk::nav::ns::ns_current |
||||
}\ |
||||
-cleanup $navcleanup\ |
||||
-result [list\ |
||||
1\ |
||||
{cannot change to namespace ::navtree::nosuchns}\ |
||||
::navtree\ |
||||
1\ |
||||
::navtree |
||||
] |
||||
|
||||
test navns_quadcolon_normalization {:::: sequences in the target normalize to ::}\ |
||||
-setup $navsetup -body { |
||||
set ::punk::nav::ns::ns_current :: |
||||
punk::nav::ns::ns/ / ::navtree::::childa |
||||
lappend result $::punk::nav::ns::ns_current |
||||
}\ |
||||
-cleanup $navcleanup\ |
||||
-result [list\ |
||||
::navtree::childa |
||||
] |
||||
|
||||
test navns_v_forms {v selects listing content: / namespaces only, // adds commands; output ends with the queried namespace line}\ |
||||
-setup $navsetup -body { |
||||
set ::punk::nav::ns::ns_current ::navtree |
||||
set o1 [punk::ansi::ansistrip [punk::nav::ns::ns/ / ""]] |
||||
set o2 [punk::ansi::ansistrip [punk::nav::ns::ns/ // ""]] |
||||
#namespaces shown in both |
||||
lappend result [string match *childa* $o1] [string match *childa* $o2] |
||||
#commands only in // |
||||
lappend result [string match *here* $o1] [string match *here* $o2] |
||||
#trailing current-namespace display line |
||||
lappend result [string match "*\n::navtree" $o1] |
||||
}\ |
||||
-cleanup $navcleanup\ |
||||
-result [list\ |
||||
1 1 0 1 1 |
||||
] |
||||
|
||||
test navns_ensemble_annotation {navigating to a namespace that is also an ensemble command annotates the display}\ |
||||
-setup $navsetup -body { |
||||
set ::punk::nav::ns::ns_current :: |
||||
set out [punk::nav::ns::ns/ / ::navtree::enschild] |
||||
lappend result [string match {*(ensemble)*} $out] |
||||
set out2 [punk::nav::ns::ns/ / ::navtree::childa] |
||||
lappend result [string match {*(ensemble)*} $out2] |
||||
}\ |
||||
-cleanup $navcleanup\ |
||||
-result [list\ |
||||
1 0 |
||||
] |
||||
} |
||||
tcltest::cleanupTests ;#needed to produce test summary line. |
||||
@ -0,0 +1,340 @@
|
||||
package require tcltest |
||||
|
||||
package require punk::ns |
||||
package require punk::console |
||||
|
||||
#added 2026-07-14 (agent) - characterization of the n/ n// n/// display machinery |
||||
#(punk::ns::get_ns_dicts classification + get_nslist/nslist rendering), requested as |
||||
#groundwork for a future rework to punk tables / terminal-width-responsive layout. |
||||
# |
||||
#Tier structure (deliberate - see the layout tests' REWORK notes): |
||||
# A: classification data (get_ns_dicts buckets) - the machine contract a table |
||||
# rework consumes; must survive any display rework untouched. |
||||
# B: marking semantics asserted PER ELEMENT and layout-agnostic (SGR fragments |
||||
# constructed live via punk::ansi::a+ / punk::ns::Cmark, located by substring - |
||||
# never whole-block pins) - also expected to survive a layout rework. |
||||
# C: current-layout pins explicitly marked REWORK - 2-column namespaces, |
||||
# 4-column commands, hardcoded 6-column namespace-path subtables - these flip |
||||
# deliberately when the punk-tables rework lands. |
||||
# |
||||
#Console queries are mocked (renderline.test pattern) - overtype/textblock sit in |
||||
#the render path and a width-responsive rework will consult get_size. |
||||
# |
||||
#Fixture findings pinned here (2026-07-14 probes): |
||||
# - packagetails = child ns whose fq name exactly matches a 'package names' entry; |
||||
# packageprefixes = a deeper package exists below the child; both => underdouble. |
||||
# - an alias overwritten by a proc of the same name classifies as a proc only (the |
||||
# alias registration is invisible to the aliases bucket), and an alias renamed |
||||
# within the namespace stays a plain als entry - so get_nslist's red-strike "-R" |
||||
# commandless-alias and yellow masked-alias display branches appear unreachable |
||||
# from current bucket derivation (rework/hygiene finding - not asserted). |
||||
# - usageinfo for an alias to a documented target only appears once the target |
||||
# namespace's punk::args definitions have been scanned (update_definitions). |
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
proc mock_console {} { |
||||
if {[llength [info commands ::punk::console::get_tabstops]]} { |
||||
rename ::punk::console::get_tabstops ::testspace::__orig_get_tabstops |
||||
} |
||||
proc ::punk::console::get_tabstops {{inoutchannels {stdin stdout}}} { |
||||
set stops {} |
||||
for {set c 9} {$c <= 201} {incr c 8} {lappend stops $c} |
||||
return $stops |
||||
} |
||||
if {[llength [info commands ::punk::console::get_size]]} { |
||||
rename ::punk::console::get_size ::testspace::__orig_get_size |
||||
} |
||||
proc ::punk::console::get_size {args} { |
||||
return [dict create columns 80 rows 24] |
||||
} |
||||
} |
||||
proc restore_console {} { |
||||
catch {rename ::punk::console::get_tabstops {}} |
||||
if {[llength [info commands ::testspace::__orig_get_tabstops]]} { |
||||
rename ::testspace::__orig_get_tabstops ::punk::console::get_tabstops |
||||
} |
||||
catch {rename ::punk::console::get_size {}} |
||||
if {[llength [info commands ::testspace::__orig_get_size]]} { |
||||
rename ::testspace::__orig_get_size ::punk::console::get_size |
||||
} |
||||
} |
||||
|
||||
#fixture: one element of each class relevant to n/ marking, in a throwaway tree |
||||
proc make_navfix {} { |
||||
namespace eval ::navfix_src { |
||||
namespace export importme |
||||
proc importme {} {return imported} |
||||
} |
||||
namespace eval ::navfix { |
||||
namespace export expo* |
||||
proc plainproc {} {return plain} |
||||
proc exposed {} {return e} |
||||
proc documented {a} {return $a} |
||||
namespace eval plainchild {} |
||||
namespace eval tailpkg {} |
||||
namespace eval prefixer {} |
||||
namespace eval bothy {} |
||||
namespace eval enschild { |
||||
namespace export dothing |
||||
proc dothing {} {return done} |
||||
namespace ensemble create |
||||
} |
||||
namespace import ::navfix_src::importme |
||||
} |
||||
package provide navfix::tailpkg 1.0 |
||||
package provide navfix::prefixer::deeppkg 1.0 |
||||
package provide navfix::bothy 1.0 |
||||
package provide navfix::bothy::subpkg 1.0 |
||||
interp alias {} ::navfix::analias {} ::lindex |
||||
interp alias {} ::navfix::dalias {} ::punk::ns::corp |
||||
#alias renamed within the namespace (stays a plain als entry - header note) |
||||
interp alias {} ::navfix::wasalias {} ::lindex |
||||
rename ::navfix::wasalias ::navfix::nowalias |
||||
#alias overwritten by a same-name proc (classifies as proc only - header note) |
||||
interp alias {} ::navfix::maskme {} ::lindex |
||||
proc ::navfix::maskme {} {return masked} |
||||
oo::class create ::navfix::Klass |
||||
::oo::object create ::navfix::oobj |
||||
coroutine ::navfix::coro apply {{} {yield ok; return done}} |
||||
punk::args::define { |
||||
@id -id ::navfix::documented |
||||
@values -min 1 -max 1 |
||||
a -type string |
||||
} |
||||
} |
||||
proc destroy_navfix {} { |
||||
catch {namespace delete ::navfix} |
||||
catch {namespace delete ::navfix_src} |
||||
foreach p {navfix::tailpkg navfix::prefixer::deeppkg navfix::bothy navfix::bothy::subpkg} { |
||||
catch {package forget $p} |
||||
} |
||||
catch {punk::args::undefine ::navfix::documented 1} |
||||
} |
||||
variable fsetup { |
||||
set result "" |
||||
::testspace::mock_console |
||||
::testspace::make_navfix |
||||
} |
||||
variable fcleanup { |
||||
::testspace::destroy_navfix |
||||
::testspace::restore_console |
||||
} |
||||
|
||||
|
||||
#Tier A ------------------------------------------------------------------ |
||||
test nslist_classification_buckets {get_ns_dicts classifies each element into its bucket (machine contract for display reworks)}\ |
||||
-setup $fsetup -body { |
||||
set d [lindex [punk::ns::get_ns_dicts ::navfix::*] 0] |
||||
lappend result [dict get $d location] |
||||
lappend result [dict get $d children] |
||||
lappend result [dict get $d packagetails] |
||||
lappend result [dict get $d packageprefixes] |
||||
lappend result [lsort [dict get $d commands]] |
||||
lappend result [dict get $d exported] |
||||
lappend result [dict get $d imported] |
||||
lappend result [lsort [dict get $d aliases]] |
||||
lappend result [lsort [dict get $d procs]] |
||||
lappend result [dict get $d ensembles] |
||||
lappend result [dict get $d ooclasses] |
||||
lappend result [dict get $d ooobjects] |
||||
lappend result [dict get $d coroutines] |
||||
lappend result [dict get $d itemcount] |
||||
}\ |
||||
-cleanup $fcleanup\ |
||||
-result [list\ |
||||
::navfix\ |
||||
{bothy enschild plainchild prefixer tailpkg}\ |
||||
{bothy tailpkg}\ |
||||
{bothy prefixer}\ |
||||
{Klass analias coro dalias documented enschild exposed importme maskme nowalias oobj plainproc}\ |
||||
exposed\ |
||||
importme\ |
||||
{analias dalias nowalias}\ |
||||
{documented exposed importme maskme plainproc}\ |
||||
enschild\ |
||||
Klass\ |
||||
oobj\ |
||||
coro\ |
||||
17 |
||||
] |
||||
|
||||
test nslist_classification_alias_edge_cases {alias overwritten by same-name proc classifies as proc only; alias renamed in-namespace stays a plain als entry}\ |
||||
-setup $fsetup -body { |
||||
set d [lindex [punk::ns::get_ns_dicts ::navfix::*] 0] |
||||
#maskme: alias registration invisible once a proc took the name |
||||
lappend result [expr {"maskme" in [dict get $d procs]}] |
||||
lappend result [expr {"maskme" in [dict get $d aliases]}] |
||||
#nowalias: renamed alias remains a live command AND an aliases entry |
||||
lappend result [expr {"nowalias" in [dict get $d aliases]}] |
||||
lappend result [expr {"nowalias" in [dict get $d commands]}] |
||||
}\ |
||||
-cleanup $fcleanup\ |
||||
-result [list\ |
||||
1 0 1 1 |
||||
] |
||||
|
||||
test nslist_classification_usageinfo {usageinfo: directly documented command always present; alias to documented target appears once target ns definitions are scanned}\ |
||||
-setup $fsetup -body { |
||||
set d [lindex [punk::ns::get_ns_dicts ::navfix::*] 0] |
||||
lappend result [expr {"documented" in [dict get $d usageinfo]}] |
||||
#dalias -> ::punk::ns::corp (a documented command). Ensure the target |
||||
#namespace's definitions are registered, then dalias joins usageinfo. |
||||
punk::args::update_definitions [list ::punk::ns] |
||||
set d2 [lindex [punk::ns::get_ns_dicts ::navfix::*] 0] |
||||
lappend result [expr {"dalias" in [dict get $d2 usageinfo]}] |
||||
lappend result [expr {"plainproc" in [dict get $d2 usageinfo]}] |
||||
}\ |
||||
-cleanup $fcleanup\ |
||||
-result [list\ |
||||
1 1 0 |
||||
] |
||||
|
||||
test nslist_classification_native_builtin_ns {native bucket populates for a builtin namespace (fixture cannot contain native commands)}\ |
||||
-setup { |
||||
set result "" |
||||
}\ |
||||
-body { |
||||
set d [lindex [punk::ns::get_ns_dicts ::tcl::mathop::*] 0] |
||||
set native [dict get $d native] |
||||
lappend result [expr {"+" in $native && "-" in $native}] |
||||
}\ |
||||
-result [list\ |
||||
1 |
||||
] |
||||
|
||||
|
||||
#Tier B ------------------------------------------------------------------ |
||||
#Marking semantics located per element - layout agnostic. SGR fragments are |
||||
#constructed live from the same punk::ansi::a+ calls get_nslist uses. |
||||
proc rawhas {raw fragment} { |
||||
return [expr {[string first $fragment $raw] >= 0}] |
||||
} |
||||
|
||||
test nslist_marking_namespace_underlines {package association selects the child-namespace underline style}\ |
||||
-setup $fsetup -body { |
||||
set raw [punk::ns::nslist -types all ::navfix::*] |
||||
#package tail AND prefix -> double underline |
||||
lappend result [rawhas $raw "[punk::ansi::a+ underdouble]bothy"] |
||||
#package tail only -> single underline |
||||
lappend result [rawhas $raw "[punk::ansi::a+ underline]tailpkg"] |
||||
#package prefix only -> dotted underline |
||||
lappend result [rawhas $raw "[punk::ansi::a+ underdotted]prefixer"] |
||||
#plain child -> cyan, no underline style directly before the name |
||||
lappend result [rawhas $raw "[punk::ansi::a+ cyan]plainchild"] |
||||
lappend result [rawhas $raw "[punk::ansi::a+ underline]plainchild"] |
||||
}\ |
||||
-cleanup $fcleanup\ |
||||
-result [list\ |
||||
1 1 1 1 0 |
||||
] |
||||
|
||||
test nslist_marking_command_type_tags {each command type renders its tag with its designated colour}\ |
||||
-setup $fsetup -body { |
||||
set raw [punk::ns::nslist -types all ::navfix::*] |
||||
lappend result [rawhas $raw "[punk::ansi::a+ bold white]prc"] |
||||
lappend result [rawhas $raw "[punk::ansi::a+ bold yellow]ens"] |
||||
lappend result [rawhas $raw "[punk::ansi::a+ bold purple]als"] |
||||
lappend result [rawhas $raw "[punk::ansi::a+ term-aqua]ooc"] |
||||
lappend result [rawhas $raw "[punk::ansi::a+ bold cyan]ooo"] |
||||
lappend result [rawhas $raw "[punk::ansi::a+ term-hotpink]cor"] |
||||
}\ |
||||
-cleanup $fcleanup\ |
||||
-result [list\ |
||||
1 1 1 1 1 1 |
||||
] |
||||
|
||||
test nslist_marking_exported_imported {exported commands colour green-bold; imported commands carry the -I marker}\ |
||||
-setup $fsetup -body { |
||||
set raw [punk::ns::nslist -types all ::navfix::*] |
||||
#note: cells pass through overtype/ansiwrap merging which canonicalizes |
||||
#SGR parameter order to bold-first - fragments constructed accordingly |
||||
lappend result [rawhas $raw "[punk::ansi::a+ bold green]exposed"] |
||||
#imported marker overtyped onto the prefix: -<bold yellow>I |
||||
lappend result [rawhas $raw "-[punk::ansi::a+ bold yellow]I"] |
||||
#plainproc is neither exported nor imported - plain white name |
||||
lappend result [rawhas $raw "[punk::ansi::a+ bold green]plainproc"] |
||||
}\ |
||||
-cleanup $fcleanup\ |
||||
-result [list\ |
||||
1 1 0 |
||||
] |
||||
|
||||
test nslist_marking_documented_icon {punk::args-documented commands get the usageinfo indicator icon; undocumented do not}\ |
||||
-setup $fsetup -body { |
||||
set raw [punk::ns::nslist -types all ::navfix::*] |
||||
set stripped [punk::ansi::ansistrip $raw] |
||||
set icon [format %c 0x24D8] |
||||
#brightgreen (92) SGR immediately preceding the icon char (params may be |
||||
#merged/reordered by the overtype pipeline - match any 92-bearing SGR) |
||||
lappend result [regexp [format {\x1b\[[0-9;]*92m%s} $icon] $raw] |
||||
#placement: appended after the documented command's cell |
||||
lappend result [string match "*documented $icon*" $stripped] |
||||
#undocumented commands carry no icon |
||||
lappend result [string match "*plainproc $icon*" $stripped] |
||||
}\ |
||||
-cleanup $fcleanup\ |
||||
-result [list\ |
||||
1 1 0 |
||||
] |
||||
|
||||
|
||||
#Tier C ------------------------------------------------------------------ |
||||
#REWORK: these pin the CURRENT hardcoded layout (2-column namespaces, 4-column |
||||
#commands, widest+8 padding, 6-column namespace-path subtables). The intended |
||||
#future rework to punk tables / terminal-width-responsive layout flips these |
||||
#deliberately - update them alongside that work, do not weaken them piecemeal. |
||||
test nslist_layout_current_columns_REWORK {current layout: namespaces 2 columns then commands 4 columns per row}\ |
||||
-setup $fsetup -body { |
||||
set stripped [punk::ansi::ansistrip [punk::ns::nslist -types all ::navfix::*]] |
||||
set lines [lsearch -all -inline -not [split $stripped \n] ""] |
||||
#3 rows: 5 children ceil-split 3+2 down 2 columns; 12 commands split 3+3+3+3 across 4 columns |
||||
lappend result [llength $lines] |
||||
#row composition asserted by ordered position (usageinfo icons can push |
||||
#into cell separators, so exact-spacing regexps would be icon-sensitive) |
||||
set row1 [lindex $lines 0] |
||||
lappend result [regexp {^bothy\s+prefixer\s} $row1] |
||||
set posns [lmap w {Klass dalias exposed nowalias} {string first $w $row1}] |
||||
lappend result [expr {-1 ni $posns && $posns eq [lsort -integer $posns]}] |
||||
set row3 [lindex $lines 2] |
||||
lappend result [regexp {^plainchild\s} $row3] |
||||
set posns3 [lmap w {coro enschild maskme plainproc} {string first $w $row3}] |
||||
lappend result [expr {-1 ni $posns3 && $posns3 eq [lsort -integer $posns3]}] |
||||
}\ |
||||
-cleanup $fcleanup\ |
||||
-result [list\ |
||||
3 1 1 1 1 |
||||
] |
||||
|
||||
test nslist_layout_nspath_subtable_REWORK {current layout: -nspathcommands renders bordered subtables for namespace path entries}\ |
||||
-setup $fsetup -body { |
||||
namespace eval ::navfix {namespace path ::navfix_src} |
||||
set stripped [punk::ansi::ansistrip [punk::ns::nslist -types all -nspathcommands 1 ::navfix::*]] |
||||
lappend result [string match "*Also resolving cmds in namespace paths:*" $stripped] |
||||
lappend result [string match "*::navfix_src*" $stripped] |
||||
lappend result [string match "*importme*" $stripped] |
||||
}\ |
||||
-cleanup { |
||||
catch {namespace eval ::navfix {namespace path {}}} |
||||
::testspace::destroy_navfix |
||||
::testspace::restore_console |
||||
}\ |
||||
-result [list\ |
||||
1 1 1 |
||||
] |
||||
|
||||
test nslist_types_default_error_QUIRK {KNOWN QUIRK: nslist without -types raises with a malformed message (literal dollar-known_types)}\ |
||||
-setup $fsetup -body { |
||||
#the shell pathway (punk::nav::ns::ns/) always passes -types, so this |
||||
#latent default is never hit interactively. Pinned for the hygiene pass: |
||||
#either give nslist a working -types default or a proper error message. |
||||
set err [catch {punk::ns::nslist ::navfix::*} msg] |
||||
lappend result $err |
||||
lappend result [string match {*Unrecognised namespace member type: $known_types*} $msg] |
||||
}\ |
||||
-cleanup $fcleanup\ |
||||
-result [list\ |
||||
1 1 |
||||
] |
||||
} |
||||
tcltest::cleanupTests ;#needed to produce test summary line. |
||||
@ -0,0 +1,196 @@
|
||||
package require tcltest |
||||
|
||||
package require punk::ns |
||||
package require punk::nav::ns |
||||
package require punk::console |
||||
|
||||
#added 2026-07-14 (agent) - repl current-namespace retention and seeding (E2 tier of |
||||
#the n/ navigation coverage - see punk/nav/ns navns.test for the nav state machine |
||||
#and punk/ns nslist.test for display characterization). |
||||
# |
||||
#Contract proven here against a REAL codethread (repl::init -type punk, driven via |
||||
#synchronous thread::send of punk::repl::codethread::runscript - no interactive |
||||
#loop, no console): |
||||
# - every submitted script evaluates tcl::namespace::inscope |
||||
# $::punk::nav::ns::ns_current in the code interp (codethread runscript) |
||||
# - navigation via punk::nav::ns::ns/ inside the codethread is retained across |
||||
# subsequent submissions |
||||
# - a deleted current namespace is auto-created on next submission with the |
||||
# 'Created namespace:' stderr notice (codethread behaviour) |
||||
# - repl::start's seeding of a new codethread from the launching context's |
||||
# ns_current (the subshell namespace carry-over) uses a template we mirror here; |
||||
# the stray-namespace defect in that template (a namespace literally named |
||||
# ::punk::nav::ns::ns_current created in every code interp) was fixed 2026-07-14 |
||||
# - pinned via the mirrored template AND a source-text guard on the module, |
||||
# pending an end-to-end piped subshell test (E3) at the shell level. |
||||
# |
||||
#Thread hygiene: one codethread for the whole file, released in the final test's |
||||
#cleanup - synchronous thread::send only (the async/result-routing hazards recorded |
||||
#in the runtests thread-topology notes don't apply to this shape). |
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
proc mock_console {} { |
||||
if {[llength [info commands ::punk::console::get_tabstops]]} { |
||||
rename ::punk::console::get_tabstops ::testspace::__orig_get_tabstops |
||||
} |
||||
proc ::punk::console::get_tabstops {{inoutchannels {stdin stdout}}} { |
||||
set stops {} |
||||
for {set c 9} {$c <= 201} {incr c 8} {lappend stops $c} |
||||
return $stops |
||||
} |
||||
if {[llength [info commands ::punk::console::get_size]]} { |
||||
rename ::punk::console::get_size ::testspace::__orig_get_size |
||||
} |
||||
proc ::punk::console::get_size {args} { |
||||
return [dict create columns 80 rows 24] |
||||
} |
||||
} |
||||
proc restore_console {} { |
||||
catch {rename ::punk::console::get_tabstops {}} |
||||
if {[llength [info commands ::testspace::__orig_get_tabstops]]} { |
||||
rename ::testspace::__orig_get_tabstops ::punk::console::get_tabstops |
||||
} |
||||
catch {rename ::punk::console::get_size {}} |
||||
if {[llength [info commands ::testspace::__orig_get_size]]} { |
||||
rename ::testspace::__orig_get_size ::punk::console::get_size |
||||
} |
||||
} |
||||
|
||||
#one shared codethread for the file (released in the last test's cleanup) |
||||
variable codethread "" |
||||
proc ensure_codethread {} { |
||||
variable codethread |
||||
if {$codethread ne ""} { |
||||
return $codethread |
||||
} |
||||
mock_console |
||||
package require punk::repl |
||||
repl::init -type punk |
||||
set codethread $::repl::codethread |
||||
restore_console |
||||
return $codethread |
||||
} |
||||
proc release_codethread {} { |
||||
variable codethread |
||||
if {$codethread ne ""} { |
||||
catch {thread::release $codethread} |
||||
set codethread "" |
||||
} |
||||
} |
||||
#run a script through the real runscript path; return stripped stdout capture |
||||
proc run_in_codethread {script} { |
||||
variable codethread |
||||
thread::send $codethread [list punk::repl::codethread::runscript $script] |
||||
set out [thread::send $codethread {interp eval code {set ::punk::repl::codethread::output_stdout}}] |
||||
thread::send $codethread {interp eval code {set ::punk::repl::codethread::output_stdout ""}} |
||||
return [string trim [punk::ansi::ansistrip $out]] |
||||
} |
||||
proc stderr_in_codethread {} { |
||||
variable codethread |
||||
set out [thread::send $codethread {interp eval code {set ::punk::repl::codethread::output_stderr}}] |
||||
thread::send $codethread {interp eval code {set ::punk::repl::codethread::output_stderr ""}} |
||||
return [string trim [punk::ansi::ansistrip $out]] |
||||
} |
||||
#the seeding block mirrors repl::start's %ns1% template (keep in sync - the |
||||
#source-text guard test below pins the module side) |
||||
proc seed_codethread {ns} { |
||||
variable codethread |
||||
thread::send $codethread [string map [list %ns1% $ns] { |
||||
interp eval code { |
||||
namespace eval ::punk::repl::codethread {} |
||||
set ::punk::repl::codethread::is_running 1 |
||||
namespace eval ::punk::nav::ns {} |
||||
set ::punk::nav::ns::ns_current %ns1% |
||||
} |
||||
}] |
||||
} |
||||
|
||||
testConstraint have_argv0 [info exists ::argv0] |
||||
|
||||
|
||||
test replns_seed_and_inscope {seeding ns_current makes runscript evaluate inscope that namespace (no stray namespace created)}\ |
||||
-constraints have_argv0\ |
||||
-setup { |
||||
set result "" |
||||
::testspace::ensure_codethread |
||||
}\ |
||||
-body { |
||||
::testspace::run_in_codethread {namespace eval ::carrytree {namespace eval sub {}}} |
||||
::testspace::seed_codethread ::carrytree |
||||
lappend result [::testspace::run_in_codethread {puts [namespace current]}] |
||||
#retention across submissions |
||||
lappend result [::testspace::run_in_codethread {puts [namespace current]}] |
||||
#the 2026-07-14 fix: seeding must NOT create a namespace named like the variable |
||||
variable codethread |
||||
lappend result [thread::send $codethread {interp eval code {namespace exists ::punk::nav::ns::ns_current}}] |
||||
}\ |
||||
-result [list\ |
||||
::carrytree\ |
||||
::carrytree\ |
||||
0 |
||||
] |
||||
|
||||
test replns_navigation_retained {punk::nav::ns::ns/ inside the codethread changes the namespace for subsequent submissions}\ |
||||
-constraints have_argv0\ |
||||
-setup { |
||||
set result "" |
||||
::testspace::ensure_codethread |
||||
}\ |
||||
-body { |
||||
::testspace::seed_codethread ::carrytree |
||||
::testspace::run_in_codethread {package require punk::ns; package require punk::nav::ns} |
||||
::testspace::run_in_codethread {punk::nav::ns::ns/ / ::carrytree::sub} |
||||
lappend result [::testspace::run_in_codethread {puts [namespace current]}] |
||||
#relative navigation from within |
||||
::testspace::run_in_codethread {namespace eval ::carrytree::sub::deeper {}} |
||||
::testspace::run_in_codethread {punk::nav::ns::ns/ / deeper} |
||||
lappend result [::testspace::run_in_codethread {puts [namespace current]}] |
||||
}\ |
||||
-result [list\ |
||||
::carrytree::sub\ |
||||
::carrytree::sub::deeper |
||||
] |
||||
|
||||
test replns_autocreate_on_missing {a deleted current namespace is auto-created on the next submission with a stderr notice}\ |
||||
-constraints have_argv0\ |
||||
-setup { |
||||
set result "" |
||||
::testspace::ensure_codethread |
||||
}\ |
||||
-body { |
||||
::testspace::seed_codethread ::carrytree::ghost |
||||
::testspace::stderr_in_codethread ;#clear |
||||
lappend result [::testspace::run_in_codethread {puts [namespace current]}] |
||||
lappend result [string match "*Created namespace: ::carrytree::ghost*" [::testspace::stderr_in_codethread]] |
||||
}\ |
||||
-result [list\ |
||||
::carrytree::ghost\ |
||||
1 |
||||
] |
||||
|
||||
test replns_start_seed_template_source_guard {repl::start's codethread seeding template targets ::punk::nav::ns (stray-namespace fix guard) - releases the shared codethread}\ |
||||
-constraints have_argv0\ |
||||
-setup { |
||||
set result "" |
||||
}\ |
||||
-body { |
||||
#source-text guard: the seeding template is inline in repl::start (only |
||||
#exercised by a live stdin repl) - pin the fixed form until an end-to-end |
||||
#piped subshell test (E3) covers it behaviourally. |
||||
set ifneeded [package ifneeded punk::repl [package provide punk::repl]] |
||||
set srcfile [lindex $ifneeded end] |
||||
set fd [open $srcfile r] |
||||
set moduletext [read $fd] |
||||
close $fd |
||||
lappend result [string match {*namespace eval ::punk::nav::ns \{\}*} $moduletext] |
||||
lappend result [string match {*namespace eval ::punk::nav::ns::ns_current*} $moduletext] |
||||
}\ |
||||
-cleanup { |
||||
::testspace::release_codethread |
||||
}\ |
||||
-result [list\ |
||||
1 0 |
||||
] |
||||
} |
||||
tcltest::cleanupTests ;#needed to produce test summary. |
||||
Loading…
Reference in new issue