Browse Source
20 pins for the previously near-unpinned punk::ns primitive region: nsparts/nsprefix/nstail/nsjoin/nsjoinall string behaviour incl weird colon-run (:::) splitting, trailing-colon parse ambiguity, round-trip exceptions; divergence pins proving nsparts1/nsprefix1/nsprefix_orig/ nstail1/nstail_orig are not drop-in twins (safe-deletion evidence); nseval create-on-eval + evaluator caching and the native-vs-punk p:::x resolution divergence; nseval_ifexists/nsexists/nschildren/nstree_raw on genuinely weird namespaces; globmatchns */**/? semantics (stale "should be fixed" comment above nsglob_as_re noted - behaviour fixed); nspath_to_absolute/nspath_here_absolute caller resolution. Warts recorded for the pass: nsjoinall error message says "nsjoin:". Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
2 changed files with 371 additions and 1 deletions
@ -0,0 +1,370 @@ |
|||||||
|
package require tcltest |
||||||
|
|
||||||
|
package require punk::ns |
||||||
|
|
||||||
|
namespace eval ::testspace { |
||||||
|
namespace import ::tcltest::* |
||||||
|
variable common { |
||||||
|
set result "" |
||||||
|
} |
||||||
|
|
||||||
|
#added 2026-07-14 (agent) - characterization pins for the punk::ns name/path string primitives and eval variants, coverage precondition for the planned punk::ns hygiene pass |
||||||
|
#The primitive region of punk::ns contains variant/deprecated twins (nsparts1, nsprefix1, nsprefix_orig, nstail1, nstail_orig) that are |
||||||
|
#consolidation candidates. The pins below record the exported primitives' behaviour AND where the twins diverge from them, so any |
||||||
|
#dead-code removal during the hygiene pass is deliberate rather than assumed-equivalent. |
||||||
|
#nsjoin/nsjoinall/nsprefix/nstail/nsparts are pure string functions - none of the namespaces used in these string pins need to exist. |
||||||
|
|
||||||
|
test nsparts_standard {nsparts splits well-formed paths - leading empty element marks fully qualified, :::: collapses to ::, spaces preserved}\ |
||||||
|
-setup $common -body { |
||||||
|
lappend result [punk::ns::nsparts ""] |
||||||
|
lappend result [punk::ns::nsparts a] |
||||||
|
lappend result [punk::ns::nsparts a::b] |
||||||
|
lappend result [punk::ns::nsparts ::a::b] |
||||||
|
lappend result [punk::ns::nsparts ::] |
||||||
|
lappend result [punk::ns::nsparts ::a::::b] |
||||||
|
lappend result [punk::ns::nsparts {::a b::c}] |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
{} a {a b} {{} a b} {{} {}} {{} a b} {{} {a b} c} |
||||||
|
] |
||||||
|
|
||||||
|
test nsparts_weird_colons {nsparts on odd colon runs - leading-colon-greedy splitting of :::, trailing colons, bare-colon segments}\ |
||||||
|
-setup $common -body { |
||||||
|
lappend result [punk::ns::nsparts :::] ;# {} : |
||||||
|
lappend result [punk::ns::nsparts :::::] ;# {} : {} |
||||||
|
lappend result [punk::ns::nsparts ::::::] ;# {} : : |
||||||
|
lappend result [punk::ns::nsparts ::a:::b] ;# {} a :b - rightmost colon binds to the tail (leading-colon preference) |
||||||
|
lappend result [punk::ns::nsparts ::a:::::b] ;# {} a : b - bare-colon middle segment |
||||||
|
lappend result [punk::ns::nsparts ::a::::::b] ;# {} a : :b |
||||||
|
lappend result [punk::ns::nsparts a:::::b] ;# a : b - relative path (no leading empty element) |
||||||
|
lappend result [punk::ns::nsparts :x] ;# single segment with leading colon |
||||||
|
lappend result [punk::ns::nsparts :::x] ;# {} :x |
||||||
|
lappend result [punk::ns::nsparts ::x:] ;# {} x: - trailing colon stays in the segment |
||||||
|
lappend result [punk::ns::nsparts ::x::] ;# {} x {} - trailing :: gives empty tail |
||||||
|
lappend result [punk::ns::nsparts ::a::b:::] ;# {} a b : |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
{{} :} {{} : {}} {{} : :} {{} a :b} {{} a : b} {{} a : :b} {a : b} :x {{} :x} {{} x:} {{} x {}} {{} a b :} |
||||||
|
] |
||||||
|
|
||||||
|
test nsparts1_divergence {nsparts1 is NOT equivalent to nsparts - its blanket ::::->:: collapse merges colon runs before splitting}\ |
||||||
|
-setup $common -body { |
||||||
|
lappend result [punk::ns::nsparts1 ::a:::b] ;# {} a :b - same as nsparts here |
||||||
|
lappend result [punk::ns::nsparts1 ::a:::::b] ;# {} a :b - DIFFERS (nsparts: {} a : b) |
||||||
|
lappend result [punk::ns::nsparts1 ::a::::::b] ;# {} a {} b - DIFFERS (nsparts: {} a : :b) - produces an empty middle segment |
||||||
|
lappend result [punk::ns::nsparts1 :::::] ;# {} : - DIFFERS (nsparts: {} : {}) |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
{{} a :b} {{} a :b} {{} a {} b} {{} :} |
||||||
|
] |
||||||
|
|
||||||
|
test nsparts_cached_coherence {nsparts_cached returns the same as nsparts for plain and weird paths}\ |
||||||
|
-setup $common -body { |
||||||
|
foreach p [list "" ::a::b ::a:::::b ::x: {::a b::c}] { |
||||||
|
lappend result [expr {[punk::ns::nsparts_cached $p] eq [punk::ns::nsparts $p]}] |
||||||
|
} |
||||||
|
set result |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
1 1 1 1 1 |
||||||
|
] |
||||||
|
|
||||||
|
test nstail_standard_and_weird {nstail returns the last nsparts segment - unlike 'namespace tail' it preserves leading/trailing colons in the tail}\ |
||||||
|
-setup $common -body { |
||||||
|
lappend result [punk::ns::nstail ""] |
||||||
|
lappend result [punk::ns::nstail ::] |
||||||
|
lappend result [punk::ns::nstail ::a] |
||||||
|
lappend result [punk::ns::nstail ::a::b] |
||||||
|
lappend result [punk::ns::nstail ::a:::b] ;# :b ('namespace tail' would give b) |
||||||
|
lappend result [punk::ns::nstail :::a] ;# :a |
||||||
|
lappend result [punk::ns::nstail ::::::a] ;# :a |
||||||
|
lappend result [punk::ns::nstail ::a::b:] ;# b: |
||||||
|
lappend result [punk::ns::nstail ::a::b::] ;# empty - trailing :: is an empty tail |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
{} {} a b :b :a :a b: {} |
||||||
|
] |
||||||
|
|
||||||
|
test nstail_variant_divergence {nstail1/nstail_orig diverge from nstail on long colon runs; nstail1 -strict errors on unpaired colons}\ |
||||||
|
-setup $common -body { |
||||||
|
lappend result [punk::ns::nstail1 ::::::a] ;# a - DIFFERS from nstail (:a) |
||||||
|
lappend result [punk::ns::nstail_orig ::::::a] ;# a - DIFFERS from nstail (:a) |
||||||
|
lappend result [punk::ns::nstail1 ::a:::b] ;# :b - same as nstail here |
||||||
|
lappend result [catch {punk::ns::nstail1 ::a:::b -strict 1} emsg] $emsg |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
a a :b 1 {nstail unpaired colon ':' in ::a:::b} |
||||||
|
] |
||||||
|
|
||||||
|
test nsprefix_variant_divergence {nsprefix1/nsprefix_orig diverge from nsprefix on colon runs of 5+ (they collapse, nsprefix keeps bare-colon segments)}\ |
||||||
|
-setup $common -body { |
||||||
|
lappend result [punk::ns::nsprefix :::::a] ;# ::: (as pinned in basic.test) |
||||||
|
lappend result [punk::ns::nsprefix1 :::::a] ;# :: - DIFFERS |
||||||
|
lappend result [punk::ns::nsprefix_orig :::::a] ;# :: - DIFFERS |
||||||
|
lappend result [punk::ns::nsprefix ::a::::::b] ;# ::a::: |
||||||
|
lappend result [punk::ns::nsprefix1 ::a::::::b] ;# ::a - DIFFERS |
||||||
|
lappend result [punk::ns::nsprefix_orig ::a::::::b] ;# ::a:: - DIFFERS (and differs from nsprefix1) |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
::: :: :: ::a::: ::a ::a:: |
||||||
|
] |
||||||
|
|
||||||
|
test nsjoin_edges {nsjoin edge cases - empty prefix absolutizes, empty name gives trailing :: (fq form of empty command name), absolute name rejects non-empty prefix}\ |
||||||
|
-setup $common -body { |
||||||
|
lappend result [punk::ns::nsjoin {} x] ;# ::x - empty prefix produces an ABSOLUTE path |
||||||
|
lappend result [punk::ns::nsjoin {} ::x] ;# ::x - absolute name passes through when prefix empty |
||||||
|
lappend result [punk::ns::nsjoin :: x] ;# ::x |
||||||
|
lappend result [punk::ns::nsjoin :: {}] ;# :: |
||||||
|
lappend result [punk::ns::nsjoin ::x::y {}] ;# ::x::y:: - fully qualified form used to call a command named as the empty string |
||||||
|
lappend result [punk::ns::nsjoin x y] ;# x::y - relative prefix stays relative |
||||||
|
lappend result [punk::ns::nsjoin ::x :y] ;# ::x:::y |
||||||
|
lappend result [catch {punk::ns::nsjoin ::x ::y} emsg] $emsg |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
::x ::x ::x :: ::x::y:: x::y ::x:::y 1 {nsjoin: won't join non-empty prefix to absolute namespace path '::y'} |
||||||
|
] |
||||||
|
|
||||||
|
test nsjoin_parse_stability {a leading-colon tail rejoins/reparses losslessly, but a trailing-colon prefix produces the same joined string and reparses differently}\ |
||||||
|
-setup $common -body { |
||||||
|
lappend result [punk::ns::nsjoin ::x :y] ;# ::x:::y |
||||||
|
lappend result [punk::ns::nsparts [punk::ns::nsjoin ::x :y]] ;# {} x :y - round trips |
||||||
|
lappend result [punk::ns::nsjoin ::x: y] ;# ::x:::y - SAME string as above (the documented trailing-colon ambiguity) |
||||||
|
lappend result [punk::ns::nsparts [punk::ns::nsjoin ::x: y]] ;# {} x :y - NOT {{} x: y} - leading-colon preference reassociates the colon |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
::x:::y {{} x :y} ::x:::y {{} x :y} |
||||||
|
] |
||||||
|
|
||||||
|
test nsprefix_nstail_nsjoin_roundtrip {nsjoin [nsprefix p] [nstail p] reassembles most inputs - exceptions are empty/bare-relative names (absolutized) and :::: collapse}\ |
||||||
|
-setup $common -body { |
||||||
|
foreach p [list :: ::a ::a::b a::b ::a:::b :::a :::::a ::a::b:: ::a::b: ::a::b:::c] { |
||||||
|
set rejoined [punk::ns::nsjoin [punk::ns::nsprefix $p] [punk::ns::nstail $p]] |
||||||
|
lappend result [expr {$rejoined eq $p}] |
||||||
|
} |
||||||
|
#non-round-trip cases |
||||||
|
lappend result [punk::ns::nsjoin [punk::ns::nsprefix ""] [punk::ns::nstail ""]] ;# "" -> :: |
||||||
|
lappend result [punk::ns::nsjoin [punk::ns::nsprefix a] [punk::ns::nstail a]] ;# a -> ::a (absolutized) |
||||||
|
lappend result [punk::ns::nsjoin [punk::ns::nsprefix ::::a] [punk::ns::nstail ::::a]] ;# ::::a -> ::a (collapsed) |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
1 1 1 1 1 1 1 1 1 1 :: ::a ::a |
||||||
|
] |
||||||
|
|
||||||
|
test nsjoinall_edges {nsjoinall - multiple segments, empty segments dropped, absolute arg allowed only while all preceding segments empty; error message says 'nsjoin:'}\ |
||||||
|
-setup $common -body { |
||||||
|
lappend result [punk::ns::nsjoinall ::] |
||||||
|
lappend result [punk::ns::nsjoinall :: a b] |
||||||
|
lappend result [punk::ns::nsjoinall ::x y z] |
||||||
|
lappend result [punk::ns::nsjoinall a b::c d] |
||||||
|
lappend result [punk::ns::nsjoinall :: {} b] ;# empty segments dropped |
||||||
|
lappend result [punk::ns::nsjoinall ::x {}] |
||||||
|
lappend result [punk::ns::nsjoinall a] ;# single arg passes through |
||||||
|
lappend result [punk::ns::nsjoinall {}] |
||||||
|
lappend result [punk::ns::nsjoinall {} {} ::y] ;# absolute arg accepted - everything before it is empty |
||||||
|
#note the error message prefix is 'nsjoin:' not 'nsjoinall:' (wart - candidate for the hygiene pass) |
||||||
|
lappend result [catch {punk::ns::nsjoinall ::x ::y} emsg] $emsg |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
:: ::a::b ::x::y::z a::b::c::d ::b ::x a {} ::y 1 {nsjoin: won't join non-empty namespace prefix to absolute namespace path '::y'} |
||||||
|
] |
||||||
|
|
||||||
|
test nseval_creates_and_caches_evaluator {nseval requires a fully qualified ns, CREATES it if missing (documented WARNING), and caches a generated evaluator proc}\ |
||||||
|
-setup $common -body { |
||||||
|
lappend result [catch {punk::ns::nseval relns {string cat hi}} emsg] $emsg |
||||||
|
lappend result [namespace exists ::punknstest_ev1] |
||||||
|
lappend result [punk::ns::nseval ::punknstest_ev1 {::tcl::namespace::current}] |
||||||
|
lappend result [namespace exists ::punknstest_ev1] ;# 1 - created as a side effect of evaluation |
||||||
|
lappend result [llength [info commands ::punk::ns::evaluator::eval-_NS_punknstest_ev1]] |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
catch {namespace delete ::punknstest_ev1} |
||||||
|
catch {rename ::punk::ns::evaluator::eval-_NS_punknstest_ev1 ""} |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
1 {nseval only accepts a fully qualified namespace} 0 ::punknstest_ev1 1 1 |
||||||
|
] |
||||||
|
|
||||||
|
test nseval_weird_path_diverges_from_native {native 'namespace eval' resolves p:::x to child x - punk::ns::nseval parses it leading-colon-greedy and creates/reaches literal child :x}\ |
||||||
|
-setup $common -body { |
||||||
|
#native Tcl treats the ::: run as a separator to a child named x |
||||||
|
lappend result [namespace eval ::punknstest_v:::x {namespace current}] ;# ::punknstest_v::x |
||||||
|
lappend result [namespace children ::punknstest_v] ;# ::punknstest_v::x |
||||||
|
#punk::ns::nseval on the same string form reaches (and creates) a child literally named :x |
||||||
|
lappend result [punk::ns::nseval ::punknstest_v2:::x {::tcl::namespace::current}] |
||||||
|
lappend result [namespace children ::punknstest_v2] ;# ::punknstest_v2:::x |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
catch {namespace delete ::punknstest_v} |
||||||
|
catch {namespace delete ::punknstest_v2} |
||||||
|
catch {rename {::punk::ns::evaluator::eval-_NS_punknstest_v2_NS_:x} ""} |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
::punknstest_v::x ::punknstest_v::x ::punknstest_v2:::x ::punknstest_v2:::x |
||||||
|
] |
||||||
|
|
||||||
|
test nseval_ifexists_plain {nseval_ifexists on plain paths - evaluates in existing ns with script errors propagating, returns empty (no creation) for missing ns}\ |
||||||
|
-setup { |
||||||
|
set result "" |
||||||
|
namespace eval ::punknstest_ie {variable marker 42} |
||||||
|
}\ |
||||||
|
-body { |
||||||
|
lappend result [punk::ns::nseval_ifexists ::punknstest_ie {set marker}] |
||||||
|
lappend result [catch {punk::ns::nseval_ifexists ::punknstest_ie {error boom}} emsg] $emsg |
||||||
|
lappend result [punk::ns::nseval_ifexists ::punknstest_missing {set marker}] |
||||||
|
lappend result [namespace exists ::punknstest_missing] ;# 0 - not created |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
catch {namespace delete ::punknstest_ie} |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
42 1 boom {} 0 |
||||||
|
] |
||||||
|
|
||||||
|
test nseval_ifexists_weird {nseval_ifexists on a genuinely weird ns (child literally named :odd) - reaches it, script errors propagate, missing weird path returns empty without creating}\ |
||||||
|
-setup { |
||||||
|
set result "" |
||||||
|
namespace eval ::punknstest_w {namespace eval {:odd} {variable marker 42}} |
||||||
|
}\ |
||||||
|
-body { |
||||||
|
#native children display is the ambiguous string form - indistinguishable from a child odd of a ns named punknstest_w: |
||||||
|
lappend result [namespace children ::punknstest_w] |
||||||
|
lappend result [punk::ns::nschildren ::punknstest_w] |
||||||
|
lappend result [punk::ns::nseval_ifexists ::punknstest_w:::odd {set marker}] |
||||||
|
lappend result [punk::ns::nseval_ifexists ::punknstest_w:::odd {info vars}] |
||||||
|
lappend result [catch {punk::ns::nseval_ifexists ::punknstest_w:::odd {error boom}} emsg] $emsg |
||||||
|
lappend result [punk::ns::nseval_ifexists ::punknstest_w:::nope {set marker}] |
||||||
|
lappend result [namespace eval ::punknstest_w {namespace exists {:nope}}] ;# 0 - not created |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
catch {namespace delete ::punknstest_w} |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
::punknstest_w:::odd ::punknstest_w:::odd 42 marker 1 boom {} 0 |
||||||
|
] |
||||||
|
|
||||||
|
test nsexists_pins {nsexists - empty string false, global true, weird ns findable, relative paths resolve against the caller namespace}\ |
||||||
|
-setup { |
||||||
|
set result "" |
||||||
|
namespace eval ::punknstest_e { |
||||||
|
namespace eval {:odd} {} |
||||||
|
namespace eval child {} |
||||||
|
} |
||||||
|
}\ |
||||||
|
-body { |
||||||
|
lappend result [punk::ns::nsexists ""] |
||||||
|
lappend result [punk::ns::nsexists ::] |
||||||
|
lappend result [punk::ns::nsexists ::punknstest_e] |
||||||
|
lappend result [punk::ns::nsexists ::punknstest_e_missing] |
||||||
|
lappend result [punk::ns::nsexists ::punknstest_e:::odd] ;# 1 - weird ns found via punk string parsing |
||||||
|
lappend result [namespace eval ::punknstest_e {punk::ns::nsexists child}] |
||||||
|
lappend result [namespace eval ::punknstest_e {punk::ns::nsexists nochild}] |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
catch {namespace delete ::punknstest_e} |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
0 1 1 0 1 1 0 |
||||||
|
] |
||||||
|
|
||||||
|
test nschildren_sort {nschildren -sort choices - default natural, ascii lsort, none unpinned order; relative ns resolves against caller}\ |
||||||
|
-setup { |
||||||
|
set result "" |
||||||
|
namespace eval ::punknstest_c { |
||||||
|
namespace eval b2 {} |
||||||
|
namespace eval b10 {} |
||||||
|
namespace eval a {namespace eval g {}} |
||||||
|
} |
||||||
|
}\ |
||||||
|
-body { |
||||||
|
lappend result [punk::ns::nschildren ::punknstest_c] ;# natural: b2 before b10 |
||||||
|
lappend result [punk::ns::nschildren -sort ascii ::punknstest_c] ;# ascii: b10 before b2 |
||||||
|
lappend result [lsort [punk::ns::nschildren -sort none ::punknstest_c]] ;# -sort none order is tcl-internal - pin membership only |
||||||
|
lappend result [namespace eval ::punknstest_c {punk::ns::nschildren a}] ;# relative resolves against caller |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
catch {namespace delete ::punknstest_c} |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
{::punknstest_c::a ::punknstest_c::b2 ::punknstest_c::b10}\ |
||||||
|
{::punknstest_c::a ::punknstest_c::b10 ::punknstest_c::b2}\ |
||||||
|
{::punknstest_c::a ::punknstest_c::b10 ::punknstest_c::b2}\ |
||||||
|
::punknstest_c::a::g |
||||||
|
] |
||||||
|
|
||||||
|
test nstree_raw_pins {nstree_raw requires a fully qualified ns and lists weird children literally}\ |
||||||
|
-setup { |
||||||
|
set result "" |
||||||
|
namespace eval ::punknstest_t { |
||||||
|
namespace eval sub {} |
||||||
|
namespace eval {:odd} {} |
||||||
|
} |
||||||
|
}\ |
||||||
|
-body { |
||||||
|
lappend result [catch {punk::ns::nstree_raw punknstest_t} emsg] $emsg |
||||||
|
lappend result [lsort [punk::ns::nstree_raw ::punknstest_t]] |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
catch {namespace delete ::punknstest_t} |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
1 {nstree_raw requires a fully qualified namespace}\ |
||||||
|
{::punknstest_t ::punknstest_t:::odd ::punknstest_t::sub} |
||||||
|
] |
||||||
|
|
||||||
|
test globmatchns_pins {globmatchns - * matches within a level (including a single inner colon) but not across ::, ** crosses levels, ? matches one non-colon char}\ |
||||||
|
-setup $common -body { |
||||||
|
lappend result [punk::ns::globmatchns ::a::* ::a::b] |
||||||
|
lappend result [punk::ns::globmatchns ::a::* ::a::b::c] ;# 0 - * does not cross :: |
||||||
|
lappend result [punk::ns::globmatchns ::a::** ::a::b::c] ;# 1 - ** crosses :: |
||||||
|
lappend result [punk::ns::globmatchns ::g*t ::got:it] ;# 1 - * matches a single inner colon (the 'should be fixed' comment above nsglob_as_re is stale - behaviour is fixed) |
||||||
|
lappend result [punk::ns::globmatchns ::a::? ::a::b] |
||||||
|
lappend result [punk::ns::globmatchns ::a::? ::a::bc] ;# 0 - ? is a single char |
||||||
|
lappend result [punk::ns::globmatchns ::w::* {::w:::odd}] ;# 1 - * at a level also matches a leading-colon (weird) child |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
1 0 1 1 1 0 1 |
||||||
|
] |
||||||
|
|
||||||
|
test nspath_absolute_helpers {nspath_to_absolute joins relative paths to a base; nspath_here_absolute resolves against the caller ns with empty-name trailing :: form}\ |
||||||
|
-setup $common -body { |
||||||
|
#namespace current is ::testspace |
||||||
|
lappend result [punk::ns::nspath_to_absolute x ::base] |
||||||
|
lappend result [punk::ns::nspath_to_absolute ::x ::base] |
||||||
|
lappend result [punk::ns::nspath_to_absolute {} ::base] |
||||||
|
lappend result [punk::ns::nspath_here_absolute] |
||||||
|
lappend result [punk::ns::nspath_here_absolute {}] ;# trailing :: - fq form of empty command name in caller ns |
||||||
|
lappend result [punk::ns::nspath_here_absolute v] |
||||||
|
lappend result [punk::ns::nspath_here_absolute ::v] |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list\ |
||||||
|
::base::x ::x ::base ::testspace ::testspace:: ::testspace::v ::v |
||||||
|
] |
||||||
|
|
||||||
|
} |
||||||
|
tcltest::cleanupTests ;#needed to produce test summary. |
||||||
Loading…
Reference in new issue