punk::path and punk::lib fixes, ongoing work on testing framework

src/modules/punk-999999.0a1.0.tm

@@ -7719,7 +7719,7 @@ namespace eval punk {
     }
 
     namespace eval argdoc {
-        set DYN_ANTIGLOB_PATHS    {${[punk::args::resolved_def -types opts ::punk::path::treefilenames -antiglob_paths]}}
+        set DYN_ANTIGLOB_PATHS    {${[punk::args::resolved_def -types opts ::punk::path::treefilenames -exclude-paths]}}
         punk::args::define {
             @dynamic
             @id -id ::punk::LOC
@@ -7737,11 +7737,11 @@ namespace eval punk {
             @opts
             -return             -default showdict -choices {dict showdict}
             -dir                -default "\uFFFF"
-            -exclude_dupfiles   -default 1 -type boolean
+            -no-dupfiles   -default 1 -type boolean
+            -no-punctlines -default 1 -type boolean
             ${$DYN_ANTIGLOB_PATHS}
-            -antiglob_files     -default "" -type list -help\
+            -exclude-files     -default "" -type list -help\
                 "Exclude if file tail matches any of these patterns"
-            -exclude_punctlines -default 1 -type boolean
             -show_largest       -default 0 -type integer -help\
                 "Report the top largest linecount files.
                   The value represents the number of files
@@ -7769,16 +7769,16 @@ namespace eval punk {
             set opt_dir [pwd] ;#pwd can take over a ms on windows in a not terribly deep path even with SSDs - so as a general rule we don't use it in the original defaults list
         }
         # -- --- --- --- --- ---
-        set opt_exclude_dupfiles    [dict get $opts -exclude_dupfiles]
+        set opt_no_dupfiles         [dict get $opts -no-dupfiles]
-        set opt_exclude_punctlines  [dict get $opts -exclude_punctlines] ;#exclude lines that consist purely of whitespace and the chars in -punctchars
+        set opt_no_punctlines       [dict get $opts -no-punctlines] ;#exclude lines that consist purely of whitespace and the chars in -punctchars
         set opt_punctchars          [dict get $opts -punctchars]
         set opt_largest             [dict get $opts -show_largest]
-        set opt_antiglob_paths      [dict get $opts -antiglob_paths]
+        set opt_exclude_paths       [dict get $opts -exclude-paths]
-        set opt_antiglob_files      [dict get $opts -antiglob_files]
+        set opt_exclude_files       [dict get $opts -exclude-files]
         # -- --- --- --- --- ---
 
 
-        set filepaths [punk::path::treefilenames -dir $opt_dir -antiglob_paths $opt_antiglob_paths -antiglob_files $opt_antiglob_files {*}$searchspecs]
+        set filepaths [punk::path::treefilenames -dir $opt_dir -exclude-paths $opt_exclude_paths -exclude-files $opt_exclude_files {*}$searchspecs]
         set loc 0
         set dupfileloc 0
         set seentails   [dict create]
@@ -7792,7 +7792,7 @@ namespace eval punk {
         set notes ""
         if {$has_hashfunc} {
             set dupfilemech sha1
-            if {$opt_exclude_punctlines} {
+            if {$opt_no_punctlines} {
                 append notes "checksums are on content stripped of whitespace lines,trailing whitespace, and pure punct lines. Does not indicate file contents equal.\n"
             } else {
                 append notes "checksums are on content stripped of whitespace lines and trailing whitespace. Does not indicate file contents equal.\n"
@@ -7814,7 +7814,7 @@ namespace eval punk {
                 continue
             }
             set lines [linelist -line {trimright} -block {trimall} $contents]
-            if {!$opt_exclude_punctlines} {
+            if {!$opt_no_punctlines} {
                 set floc [llength $lines]
                 set comparedlines $lines
             } else {
@@ -7852,7 +7852,7 @@ namespace eval punk {
                     incr dupfileloc $floc
                 }
             }
-            if {!$isdupfile || ($isdupfile && !$opt_exclude_dupfiles)} {
+            if {!$isdupfile || ($isdupfile && !$opt_no_dupfiles)} {
                 incr loc $floc
                 incr purepunctlines $fpurepunctlines
             }
@@ -7881,11 +7881,11 @@ namespace eval punk {
                         ] dupfileloc              $dupfileloc               {*}[
                         ] dupinfo                 $dupinfo                  {*}[
                         ] extensions              $extensions               {*}[
-                        # purepunctuationlines key only retained if punctuation lines are excluded from count by opt_exclude_punctlines
+                        # purepunctuationlines key only retained if punctuation lines are excluded from count by opt_no_punctlines
                         ] purepunctuationlines    $purepunctlines           {*}[
                         ] notes                   $notes                    {*}[
         ]]
-        if {!$opt_exclude_punctlines} {
+        if {!$opt_no_punctlines} {
             dict unset result purepunctuationlines
         }
 

src/modules/punk/ansi-999999.0a1.0.tm

@@ -10349,8 +10349,9 @@ tcl::namespace::eval punk::ansi::ansistring {
     set hack [tcl::dict::create]
     tcl::dict::set hack BOM1 [list \uFEFF "${obm}\U1f4a3$cbm"]    ;#byte order mark/ ZWNBSP (ZWNBSP usage generally deprecated) - a picture of a bomb(2wide glyph)
     tcl::dict::set hack ZWSP [list \u200B "${obm}ZWSP$cbm"]
-    tcl::dict::set hack ZWNJ [list \u200D "${obm}ZWNJ$cbm"]        ;#zero width non-joiner.
+    tcl::dict::set hack ZWNJ [list \u200C "${obm}ZWNJ$cbm"]        ;#zero width non-joiner.
     tcl::dict::set hack ZWJ  [list \u200D "${obm}ZWJ$cbm"]
+    tcl::dict::set hack CGJ [list  \u034F "${obm}CGJ$cbm"]        ;#combining grapheme joiner (MISNOMER) - zero width, but semantically important in some contexts - for example in indic scripts - where it can affect the shaping of the preceding character(s)
     #review - other boms? Encoding dependent?
 
 

src/modules/punk/char-999999.0a1.0.tm

@@ -3033,13 +3033,15 @@ tcl::namespace::eval punk::char {
     #This still leaves a whole class of clusters.. korean etc unhandled :/
     #todo - tk::startOfCluster / tk::endOfCluster - try to get it brought into Tcl
     #https://core.tcl-lang.org/tcl/tktview/a4c7eeaf63
-    proc grapheme_split {text} {
+    proc grapheme_split {text {return list}} {
         #we should treat \r\n as a single grapheme cluster (as tk::endOfCluster does)
         set components [list]
         set csplits [combiner_split $text]
         foreach {pt combiners} [lrange $csplits 0 end-1] {
             set clist [split $pt ""]
-            lset clist end [tcl::string::cat [lindex $clist end] $combiners]
+            #review
+            #lset clist end [tcl::string::cat [lindex $clist end] $combiners]
+            ledit clist end end [tcl::string::cat [lindex $clist end] $combiners]
             lappend components {*}$clist
             #lappend components {*}[lrange $clist 0 end-1]
             #lappend components [tcl::string::cat [lindex $clist end] $combiners]
@@ -3183,7 +3185,11 @@ tcl::namespace::eval punk::char {
         if {$current_cluster ne ""} {
             lappend graphemes $current_cluster
         }
-        return $graphemes
+        if {$return eq "list"} {
+             return $graphemes
+        } else {
+             return [dict create list $graphemes last_extensible $current_cluster_is_extensible base $cluster_base RI_base $cluster_base_RI]
+        }
     }
     namespace eval grapheme_split {
         proc about {} {

src/modules/punk/lib-999999.0a1.0.tm

@@ -138,36 +138,29 @@ tcl::namespace::eval punk::lib::check {
         if {"windows" ne $::tcl_platform(platform)} {
             set bug 0
         } else {
-            if {![catch {file tempdir} tmpdir]} {
+            set tmpdir [punk::lib::tempdir_newfolder] ;#uses 'file tempdir' on tcl9+ or fallback to env vars or current directory on older versions
-                #tcl 9+ has 'file tempdir'
+            set testfile [file join $tmpdir "bugtest"]
-                set testfile [file join $tmpdir "bugtest"]
+
-            } else {
+            try {
-                #fallback for older tcl versions - use env TEMP/TMP or current directory
+                set fd [open $testfile w]
-                set tmpdir ""
+                puts $fd test
-                foreach e {TEMP TMP} {
+                close $fd
-                    if {[info exists ::env($e)] && [file isdirectory ::env($e)]} {
+                set globresult [glob -nocomplain -directory $tmpdir -types f -tail BUGTEST {BUGTES{T}} {[B]UGTEST} {\BUGTEST} BUGTES? BUGTEST*]
-                        set tmpdir ::env($e)
+                if {[file exists $testfile]} {
+                    file delete $testfile
+                }
+                foreach r $globresult {
+                    if {$r ne "bugtest"} {
+                        set bug 1
                         break
                     }
                 }
-                if {$tmpdir eq ""} {
+            } finally {
-                    #no env vars - fallback to current directory
+                if {[file exists $testfile]} {
-                    set tmpdir [pwd]
+                    file delete $testfile
                 }
-                set testfile [file join $tmpdir "bugtest"]
+                if {[file exists $tmpdir]} {
-            }
+                    file delete -force $tmpdir
-
-            set fd [open $testfile w]
-            puts $fd test
-            close $fd
-            set globresult [glob -nocomplain -directory $tmpdir -types f -tail BUGTEST {BUGTES{T}} {[B]UGTEST} {\BUGTEST} BUGTES? BUGTEST*]
-            if {[file exists $testfile]} {
-                file delete $testfile
-            }
-            foreach r $globresult {
-                if {$r ne "bugtest"} {
-                    set bug 1
-                    break
                 }
             }
         }
@@ -679,7 +672,207 @@ namespace eval punk::lib {
         }
     }
 
+    namespace eval argdoc {
+        variable PUNKARGS
+        lappend PUNKARGS [list {
+            @id     -id     ::punk::lib::tempdir
+            @cmd    -name     punk::lib::tempdir\
+                -summary\
+                "Determine an appropriate temp dir for the process we are running under."\
+                -help\
+                "On windows:
+                  If the process is running under the system account use the modern windows location: %SystemRoot%\SystemTemp
+                  Detection of the system account relies on either twapi, or a combination of the whoami command and the 
+                  registry package.
+                  Proceeds with same fallback logic as for other platforms if we fail to detect the system account or its temp location.
+
+
+                For other platforms we use the environment variables TMPDIR/TEMP/TMP or fallback to /tmp or /var/tmp if those
+                env vars aren't set or aren't writable directories.
+
+                Final fallback attempt is the current working directory.
+                Result is normalized so resulting path will have forward slashes on all platforms.
+
+                Alternatives: see the tcllib fileutil::tempdir function.
+                "
+            @values -min 0 -max 0
+        }]
+    }
+    proc tempdir {} {
+        set trydirs [list]
+        if {"windows" eq $::tcl_platform(platform)} {
+            #review.
+            #consider also checking for whether running under various service accounts
+
+            if {![catch {package require twapi}]} {
+                set tok [twapi::open_process_token] ;#first call is a little pricy.
+                set sid [twapi::get_token_user $tok]
+                if {$sid eq "S-1-5-18"} {
+                    #system account - use system account temp location
+                    set sysroot [twapi::get_shell_folder csidl_windows] ;#first call is a little pricy.
+                    lappend trydirs [file join $sysroot "SystemTemp"]
+                }
+                #if not system account - use env vars as first choice.
+            } else {
+                #twapi not available - try to use builtin windows whoami to detect if we're running under system account - but this is less reliable than using twapi to check the process token - so we warn about it.
+                set whoami_exe [auto_execok whoami]
+                #test that system32 is somewhere in the whoami path as a basic attempt to avoid non-windows whoami commands that might be present in the path
+                set whoami_exe_parts [file split $whoami_exe]
+                if {"system32" in [string tolower $whoami_exe_parts]} {
+                    set whoamiresult [string trim [exec {*}$whoami_exe /USER /FO LIST] \n\r]
+                    set whoamiresult [string map {\r\n \n} $whoamiresult]
+                    set whoamiresult_lines [split $whoamiresult \n]
+                    set sid ""
+                    foreach line $whoamiresult_lines {
+                        if {[string match "SID:*" $line]} {
+                            set sid [lindex $line 1]
+                            break
+                        }
+                    }
+                    set has_registry [expr {![catch {package require registry}]}]
+                    if {$sid eq "S-1-5-18"} {
+                        #system account - use system account temp location
+                        set sysroot ""
+                        if {$has_registry} {
+                            #registry path is case-insensitive.
+                            catch {
+                                set sysroot [registry get {HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion} SystemRoot]
+                            }
+                        } else {
+                            if {[info exists ::env(SystemRoot)]} {
+                                set sysroot [set ::env(SystemRoot)]
+                            }
+                        }
+                        if {$sysroot ne ""} {
+                            lappend trydirs [file join $sysroot "SystemTemp"]
+                        }
+                    }
+                    #if not system account - use env vars as first choice.
+                }
+            }
+        }
+
+        foreach t {TMPDIR TEMP TMP} {
+            #TMPDIR is the posix standard as first choice for temp dir env var.
+            if {[info exists ::env($t)]} {
+                lappend trydirs $::env($t)
+            }
+        }
+
+        if {"windows" ne $::tcl_platform(platform)} {
+            #suitable for macos,linux and freebsd at least.
+            lappend trydirs [file join / tmp] [file join / var tmp]
+            #/usr/tmp is probably not a common location for a temp dir on modern unix-based systems.
+        }
+
+        foreach d $trydirs {
+            if {[file isdirectory $d] && [file writable $d]} {
+                return [file normalize $d]
+            }
+        }
+
+        #only even call 'pwd' as a last resort (mildly slow on first call).
+        set cwd [pwd]
+        if {[file isdirectory $cwd] && [file writable $cwd]} {
+            return $cwd
+        }
+
+        return -code error "punk::lib::tempdir unable to determine a suitable temp directory - tried: $trydirs"
+    }
+
+    namespace eval argdoc {
+        variable PUNKARGS
+        lappend PUNKARGS [list {
+            @id     -id     ::punk::lib::tempdir_newfolder
+            @cmd    -name     punk::lib::tempdir_newfolder\
+                -summary\
+                "Create unique folder within temp dir (or cwd as last resort)"\
+                -help\
+                "Creates a new unique folder within the temp dir determined by punk::lib::tempdir.
+                The folder is created before returning its full path and will be empty.
+                The folder is named with a tcl_ prefix followed by a random string.
+
+                See also: 'file tempdir' in tcl 9+ or fileutil::maketempdir from tcllib"
+            @opts
+                -dir -type string -default "" -help\
+                    "Base directory to create the temp folder in - defaults to the result of punk::lib::tempdir"
+                -prefix -type string -default tcl -help\
+                    "Prefix for the temp folder name
+                    An underscore is automatically appended to the prefix in the generated folder name.
+                    If prefix is the empty string - then the generated folder name will still be autoprefixed
+                    with tcl_  (consistent with tcl9 'file tempdir')"
+            @values -min 0 -max 0
+        }]
+    }
+    proc tempdir_newfolder {args} {
+        set argd [punk::args::parse $args withid ::punk::lib::tempdir_newfolder]
+        set opt_dir [dict get $argd opts -dir]
+        set opt_prefix [dict get $argd opts -prefix]
+        puts "opt_prefix: $opt_prefix"
+        if {[llength [file split $opt_prefix]] > 1} {
+            error "punk::lib::tempdir_newfolder -prefix option should not contain any path separators"
+        }
+        if {$opt_prefix eq ""} {
+            #don't allow empty prefix - for consistency with tcl9 'file tempdir' - which would still prefix with 'tcl_' even if prefix is empty string.
+            set opt_prefix "tcl"
+        }
+
+        if {$opt_dir ne ""} {
+            if {[file isdirectory $opt_dir] && [file writable $opt_dir]} {
+                set tmpbase [file normalize $opt_dir]
+            } else {
+                error "punk::lib::tempdir_newfolder -dir option '$opt_dir' is not a writable directory"
+            }
+        } else {
+            set tmpbase [punk::lib::tempdir] ;#will raise an error if no writable temp dir or cwd found.
+        }
+        #assert: tmpbase has no trailing slash - unless it is a root dir (e.g / on unix, or C:/ on windows)
+        #assert: tmpbase is normalized with forward slashes on all platforms.
+
+        set tcl9_template_base [string trimright $tmpbase "/"] ;#set it to a form that can join along with a forward slash to prefix for tcl 9 'file tempdir' style template.
+        #tcl9 'file tempdir' separates the prefix in the template from the random string with an underscore.
 
+        #now form template by always joining with a slash (even if opt_prefix is empty)
+        #(avoiding file join and file normalize to ensure template is properly formed)
+        #whether or not opt_prefix ends with an underscore - another will be added. (by file tempdir, or by our own code if tcl9 'file tempdir' isn't available)
+        #assert: opt_prefix is not empty string (will have defaulted to 'tcl') and does not contain any path separators.
+        set tcl9_template "$tcl9_template_base/$opt_prefix"
+
+
+        #tcl 9+ has 'file tempdir'
+        #we don't support the same template as 'file tempdir'
+        if {[catch {file tempdir $tcl9_template} tmpdir]} {
+
+            set prefix tcl_ ;#todo - accept option: -prefix
+
+            set chars abcddefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
+            set nrand_chars 8
+            set maxtries 100
+            for {set i 0} {$i < $maxtries} {incr i} {
+                set dirname ${opt_prefix}_  ;#always add underscore for consistency with tcl9 'file tempdir'.
+                for {set j 0} {$j < $nrand_chars} {incr j} {
+                    append dirname [string index $chars [expr {int(rand()*62)}]]
+                }
+                set path [file join $tmpbase $dirname]
+                if {[file exists $path]} {
+                    continue
+                }
+                if {[catch {
+                        file mkdir $path
+                        if {"windows" ne $::tcl_platform(platform)} {
+                            file attributes $path -permissions 0o700
+                        }
+                    }]} {
+                    continue
+                }
+                return $path
+            }
+            return -code error "punk::lib::tempdir_newfolder unable to create unique tempdir in $tmpbase after $maxtries attempts - too many collisions - aborting"
+        }
+        #tcl 9 'file tempdir' return.
+        #normalize because on early tcl 9 versions on windows it can return with mixed forward and backward slashes when a template is supplied with forward slashes.
+        return [file normalize $tmpdir]
+    }
 
     # == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == ==
     # Maintenance - This is the primary source for tm_version... functions
@@ -814,6 +1007,89 @@ namespace eval punk::lib {
             error "tm_version_required_canonical should have already returned a canonicalised versionspec - or produced an error with reason before this point"
         }
     }
+    proc tm_version_magic {} {
+        #maintenance instruction:
+        #  This specific 12 character nnnnnn.0a1.0 version number is used in text replacement when installing modules.
+        #  It should not be modified without also considering the impact on existing projects based on punkshell that may have used this version number in their own code or documentation as a placeholder for tm version handling.
+        #  A copy of this is also present in punk::lib.
+        #  Essentially this should probably never be changed - and instead deprecated if we want to stop using it and replaced with a different mechanism/placeholder.
+
+        #tm versioning is not quite the same as semantic versioning - but similarly we should see extremely high major version numbers rarely if ever in real use,
+        #even over decades of development.
+        set magicbase 999999  ;#deliberately large so given load-preference when testing!
+        #we split the literal to avoid the literal appearing here - reduce risk of accidentally converting to a release version
+        return ${magicbase}.0a1.0
+    }
+
+    namespace eval argdoc {
+        lappend PUNKARGS [list {
+            @id     -id     ::punk::lib::tm_split_name
+            @cmd    -name     punk::lib::tm_split_name\
+                -summary\
+                "Split a versioned module name into name and version parts, dropping trailing .tcl/.tm if any."\
+                -help\
+                "Splits a versioned module name (as present in a filename or namespaced name) into name and version parts,
+                Ignores any trailing .tm or .tcl file extension.
+
+                If the fullmodulename given is a namespaced name - then the returned modulename will also be namespaced,
+                but with any leading :: removed.
+
+                Returns a two element list - with the first element being the modulename and the second element being the version.
+
+                Tcl module version numbers are understood with leading zeros in each dotted part, but leading zeros are not canonical.
+
+                This split does not canonicalise the version number.
+                If the last dash-separated segment of the name doesn't look like a valid version number
+                - then it is treated as part of the modulename and an empty version string is returned.
+                e.g
+                  mymod-1.2.3.tm -> mymod 1.2.3
+                  mymod-1aa2.3.tm -> mymod-1aa2.3 {}
+                  (repeated a is not a valid version segment - so the entire '1aa2.3' is treated as part of the modulename)
+
+                see also: tm_version_canonical
+                "
+            @values -min 1 -max 1
+            fullmodulename -type string -help\
+                "The full module name to split - as present in a filename or namespaced name. E.g:
+                mymod-1.2.3
+                mymod-1.2.3.tm
+                mymod-1.2.3.tcl
+                /some/where/mymod-123.0a4.0.tm
+                mymod
+                mymod.tm
+                mymod.tcl
+                ns1::ns2::mymod-1.2.3
+                ::ns1::ns2::mymod"
+        }]
+    }
+    proc tm_split_name {fullmodulename} {
+        #split modulename (as present in a filename or namespaced name) into name/version ignoring leading namespace path
+        #ignore trailing .tm .TM if present
+        #if version doesn't pass validation - treat it as part of the modulename and return empty version string without error
+        #Up to caller to validate.
+        set lastpart [namespace tail $fullmodulename]
+        set lastpart [file tail $lastpart] ;# should be ok to use file tail now that we've ensured no namespace components
+        if {[string tolower [file extension $fullmodulename]] in {.tcl .tm}} {
+            set fileparts [split [file rootname $lastpart] -]
+        } else {
+            set fileparts [split $lastpart -]
+        }
+        if {[tm_version_isvalid [lindex $fileparts end]]} {
+            set versionsegment [lindex $fileparts end]
+            set namesegment [join [lrange $fileparts 0 end-1] -];#re-stitch
+        } else {
+            set namesegment [join $fileparts -]
+            set versionsegment ""
+        }
+        set base [string trimleft [namespace qualifiers $fullmodulename] :]
+        if {$base ne ""} {
+            set modulename "${base}::$namesegment"
+        } else {
+            set modulename $namesegment
+        }
+        return [list $modulename $versionsegment]
+    }
+
     # end tm_version... functions
     # == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == ==
 

src/modules/punk/mix/cli-999999.0a1.0.tm

@@ -499,7 +499,7 @@ namespace eval punk::mix::cli {
             # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
             set opt_punkcheck_eventobj                   [dict get $opts -punkcheck_eventobj]
 
-            set magicversion [punk::mix::util::magic_tm_version] ;#deliberately large so given load-preference when testing
+            set magicversion [punk::mix::util::tm_version_magic] ;#deliberately large so given load-preference when testing
             set module_list [list]
 
             if {[file tail [file dirname $srcdir]] ne "src"} {

src/modules/punk/mix/commandset/module-999999.0a1.0.tm

@@ -362,7 +362,7 @@ namespace eval punk::mix::commandset::module {
         file mkdir $modulefolder
 
         set moduletail [namespace tail $modulename]
-        set magicversion [punk::mix::util::magic_tm_version] ;#deliberately large so given load-preference when testing
+        set magicversion [punk::mix::util::tm_version_magic] ;#deliberately large so given load-preference when testing
 
 
 

src/modules/punk/mix/commandset/project-999999.0a1.0.tm

@@ -380,25 +380,25 @@ namespace eval punk::mix::commandset::project {
 
         puts stdout ">>> about to call punkcheck::install $layout_path $projectdir"
         set resultdict [dict create]
-        set antipaths [list\
+        set antipaths [list         {*}{
-            src/doc/*\
+            src/doc/*
-            src/doc/include/*\
+            src/doc/include/*
-            src/PROJECT_LAYOUTS_*\
+            src/PROJECT_LAYOUTS_*
-        ]
+        }]
-
+
-        #set antiglob_dir [list\
+        #set exclude_dirsegments [list {*}{
-        #    _ignore_*\
+        #    _ignore_*
-        #]
+        #}]
-        set antiglob_dir [list\
+        set exclude_dirsegments [list {*}{
-        ]
+        }]
-
+
-        #default antiglob_dir_core will stop .fossil* from being updated - which is generally desirable as these are likely to be customized
+        #default -exclude-dirsegments_core will stop .fossil* from being updated - which is generally desirable as these are likely to be customized
         if {$opt_force} {
             puts stdout "copying layout files - with force applied - overwrite all-targets"
-            set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1  -overwrite ALL-TARGETS -antiglob_paths $antipaths -antiglob_dir $antiglob_dir]
+            set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1  -overwrite ALL-TARGETS -antiglob_paths $antipaths -exclude-dirsegments $exclude_dirsegments]
         } else {
             puts stdout "copying layout files - (if source file changed)"
-            set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1 -overwrite installedsourcechanged-targets -antiglob_paths $antipaths -antiglob_dir $antiglob_dir]
+            set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1 -overwrite installedsourcechanged-targets -antiglob_paths $antipaths -exclude-dirsegments $exclude_dirsegments]
         }
         puts stdout [punkcheck::summarize_install_resultdict $resultdict]
 
@@ -412,11 +412,11 @@ namespace eval punk::mix::commandset::project {
 
         #target folders .fossil-custom and .fossil-settings may not exist. use -createdir 1 to ensure existence.
         #In this case we need to override the default dir antiglob - as .fossil-xxx folders need to be installed from template if missing, or if target is uncustomized.
-        ## default_antiglob_dir_core  [list "#*" "_aside" ".git" ".fossil*"]
+        ## default_exclude_dirsegments_core  [list "#*" "_aside" ".git" ".fossil*"]
-        set override_antiglob_dir_core [list #* _aside .git]
+        set override_exclude_dirsegments_core [list #* _aside .git]
         if {[file exists $layout_path/.fossil-custom]} {
             puts stdout "copying layout src/.fossil-custom files (if target missing or uncustomised)"
-            set resultdict [punkcheck::install $layout_path/.fossil-custom $projectdir/.fossil-custom -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS]
+            set resultdict [punkcheck::install $layout_path/.fossil-custom $projectdir/.fossil-custom -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -exclude-dirsegments_core $override_exclude_dirsegments_core -overwrite SYNCED-TARGETS]
             puts stdout [punkcheck::summarize_install_resultdict $resultdict]
         } else {
             puts stdout "no .fossil-custom in source template - update not required"
@@ -424,7 +424,7 @@ namespace eval punk::mix::commandset::project {
 
         if {[file exists $layout_path/.fossil-settings]} {
             puts stdout "copying layout src/.fossil-settings files (if target missing or uncustomised)"
-            set resultdict [punkcheck::install $layout_path/.fossil-settings $projectdir/.fossil-settings -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS]
+            set resultdict [punkcheck::install $layout_path/.fossil-settings $projectdir/.fossil-settings -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -exclude-dirsegments_core $override_exclude_dirsegments_core -overwrite SYNCED-TARGETS]
             puts stdout [punkcheck::summarize_install_resultdict $resultdict]
         } else {
             puts stdout "no .fossil-settings in source template - update not required"
@@ -470,8 +470,8 @@ namespace eval punk::mix::commandset::project {
         if {[file exists $projectdir/src/modules]} {
             foreach m $opt_modules {
                 #check if mod-ver.tm file or #modpod-mod-ver folder exist
-                set tmfile $projectdir/src/modules/$m-[punk::mix::util::magic_tm_version].tm
+                set tmfile $projectdir/src/modules/$m-[punk::mix::util::tm_version_magic].tm
-                set podfile $projectdir/src/modules/#modpod-$m-[punk::mix::util::magic_tm_version]/$m-[punk::mix::util::magic_tm_version].tm
+                set podfile $projectdir/src/modules/#modpod-$m-[punk::mix::util::tm_version_magic]/$m-[punk::mix::util::tm_version_magic].tm
 
                 set has_tm  [file exists $tmfile]
                 set has_pod [file exists $podfile]

src/modules/punk/mix/util-999999.0a1.0.tm

@@ -367,7 +367,16 @@ namespace eval punk::mix::util {
     }
     #todo - semver conversion/validation for other systems?
 
-    proc magic_tm_version {} {
+    proc tm_version_magic {} {
+        #maintenance instruction:
+        #  This specific 12 character nnnnnn.0a1.0 version number is used in text replacement when installing modules.
+        #  It should not be modified without also considering the impact on existing projects based on punkshell that may have used this version number in their own code or documentation as a placeholder for tm version handling.
+        #  A copy of this is also present in punk::lib to aid in dependency management.
+        #  These 2 copies should be kept in sync.
+        #  Essentially this should probably never be changed - and instead deprecated if we want to stop using it and replaced with a different mechanism/placeholder.
+
+        #tm versioning is not quite the same as semantic versioning - but similarly we should see extremely high major version numbers rarely if ever in real use,
+        #even over decades of development.
         set magicbase 999999  ;#deliberately large so given load-preference when testing!
         #we split the literal to avoid the literal appearing here - reduce risk of accidentally converting to a release version
         return ${magicbase}.0a1.0

src/modules/punk/ns-999999.0a1.0.tm

@@ -721,6 +721,22 @@ tcl::namespace::eval punk::ns {
     }
 
 
+    punk::args::define {
+        @id     -id ::punk::ns::nstree_list
+        @cmd    -name punk::ns::nstree_list\
+            -summary\
+            ""\
+            -help\
+            ""
+        @leaders
+            location -type path -optional 0
+        @opts
+            -subnslist -type list -default {} -help\
+            ""
+            -allbelow -type boolean -default 1 -help\
+            ""
+        @values -min 0 -max 0
+    }
     #important: add tests for tricky cases - e.g punk::m**::util  vs punk::m*::util vs punk::m*::**::util  - these should all be able to return different results depending on namespace structure.
     #e.g punk::m**::util will return punk::mix::util  but punk::m*::**::util will not because punk::mix::util is too short to match. Both will return deeper matches such as: punk::mix::commandset::repo::util
     proc nstree_list {location args} {

src/modules/punk/path-999999.0a1.0.tm

@@ -740,10 +740,10 @@ namespace eval punk::path {
         return $ismatch
     }
     punk::args::define {
-        @id     -id     ::punk::path::subfolders
+        @id     -id     ::punk::path::subfolders1
-        @cmd    -name     punk::path::subfolders\
+        @cmd    -name     punk::path::subfolders1\
             -summary\
-            "Listing of directories within supplied path."\
+            "Listing of directories below supplied path."\
             -help\
             "List of folders below path.
             The resulting list is unsorted."
@@ -771,20 +771,20 @@ namespace eval punk::path {
             (so should be written to match the same relative prefix if path is relative)"
     }
 
-    proc subfolders {args} {
+    proc subfolders1 {args} {
         #NOTE - this algorithm based on omit_only_patterns and prune_base_patterns was suggested by a 2026 AI model - it is apparent to this programmer that it is inadequate for the purpose.
-        #e.g consider subfolders -recursion -exclude {**/vfs/** **/src/**}
+        #e.g consider subfolders1 -recursion -exclude {**/vfs/** **/src/**}
         #This can still return something like c:/repo/etc/src/vfs - which should be excluded by the pattern **/src/**
         #todo - review and fix properly.
-        set argd [punk::args::parse $args withid ::punk::path::subfolders]
+        set argd [punk::args::parse $args withid ::punk::path::subfolders1]
         lassign [dict values $argd] leaders opts values received
         set do_recursion    [dict exists $received -recursive]
         set exclude_paths   [dict get $opts -exclude-paths]
         if {"**" in $exclude_paths} {
             #if ** is in exclude_paths - then we can skip all glob matching and just return empty list
             #This is likely user error - so we'll be loud about it for now but will still return empty list rather than erroring.
-            #If user code is building exclude_paths dynamically - they can check for this case themselves and avoid the call to subfolders to suppress this message.
+            #If user code is building exclude_paths dynamically - they can check for this case themselves and avoid the call to subfolders1 to suppress this message.
-            puts stderr "punk::path::subfolders Warning - exclude_paths contains '**' - all paths will be excluded"
+            puts stderr "punk::path::subfolders1 Warning - exclude_paths contains '**' - all paths will be excluded"
             return [list]
         }
         if {[dict exists $received path]} {
@@ -806,49 +806,32 @@ namespace eval punk::path {
         # **/test/** - would exclude any path with test as a segment and all its subfolders
         #- but not paths with test as a segment that is the final segment
 
-
-        set omit_only_patterns [list]
-        set prune_base_patterns [list]
-        foreach pat $exclude_paths {
-            set pat_parts [file split $pat] ;#note file split c:/test gives {c:/ test}  but file split **/test gives {** test}
-            #also note that file split on windows treats forward slashes and backslashes the same.
-            #by using file split, we gain some flexibility in syntax of paths and patterns,
-            #but lose the ability to use backslashes as escapes to allow literal glob characters in path segments.
-            #This is almost always a non-issue on windows since * and ? are not valid in path segments there, and is rarely an issue on unix even though
-            # * and ? are technically valid in path segments, but it is inadvisable there anyway for compatibility with shells etc.
-            if {[llength $pat_parts] >= 2 && [lindex $pat_parts end] eq "**"} {
-                #** at end of pattern  - e.g /dir/etc/**
-                #Convert ".../" to base "...", and prune descendants of that base.
-                lappend prune_base_patterns [file join {*}[lrange $pat_parts 0 end-1]]
-            } else {
-                lappend omit_only_patterns $pat
-            }
-        }
-
         set folders [list]
         set recurse_subdirs [list]
 
         foreach f $all_subfolders {
             set include_in_results 1
             set allow_recurse 1
-            foreach pat $omit_only_patterns {
+            foreach pat $exclude_paths {
-                if {[globmatchpath $pat $f]} {
+                set pat_parts [file split $pat] ;#note file split c:/test gives {c:/ test}  but file split **/test gives {** test}
-                    set include_in_results 0
+                #also note that file split on windows treats forward slashes and backslashes the same.
-                    break
+                #by using file split, we gain some flexibility in syntax of paths and patterns,
-                }
+                #but lose the ability to use backslashes as escapes to allow literal glob characters in path segments.
-            }
+                #This is almost always a non-issue on windows since * and ? are not valid in path segments there, and is rarely an issue on unix even though
-            if {$allow_recurse && [llength $prune_base_patterns]} {
+                # * and ? are technically valid in path segments, but it is inadvisable there anyway for compatibility with shells etc.
-                foreach base_pat $prune_base_patterns {
+                if {[llength $pat_parts] >= 2 && [lindex $pat_parts end] eq "**"} {
-                    #prune both the matched base node and its decendants.
+                    set base_pat [file join {*}[lrange $pat_parts 0 end-1]]
-                    if {[globmatchpath $base_pat $f]} {
+                    if {[globmatchpath $pat $f]} {
-                        set allow_recurse 0
-                        break
-                    }
-                    if {[globmatchpath "${base_pat}/**" $f]} {
                         set include_in_results 0
                         set allow_recurse 0
-                        break
+                    } elseif {[globmatchpath $base_pat $f]} {
+                        set allow_recurse 0
                     }
+                } elseif {[globmatchpath $pat $f]} {
+                    set include_in_results 0
+                }
+                if {!$include_in_results && !$allow_recurse} {
+                    break
                 }
             }
             if {$include_in_results} {
@@ -860,392 +843,586 @@ namespace eval punk::path {
         }
         if {$do_recursion} {
             foreach subdir $recurse_subdirs {
-                lappend folders {*}[subfolders -exclude-paths $exclude_paths -recursive $subdir]
+                lappend folders {*}[subfolders1 -exclude-paths $exclude_paths -recursive $subdir]
             }
         }
-
-        #if {[llength $exclude_paths]} {
-        #    set folders [list]
-        #    foreach f $all_subfolders {
-        #        set skip 0
-        #        foreach pat $exclude_paths {
-        #            #review - this is slightly too simplistic.
-        #            # for exclusion pattern **/dirname
-        #            # this will exclude any path with dirname as final segment - but it will also exclude any path with dirname as a segment anywhere in the path - which is not intended.
-        #            #puts stderr "Checking exclude pat '$pat' against '$f'"
-        #            if {[globmatchpath $pat $f]} {
-        #                set skip 1
-        #                break
-        #            }
-        #        }
-        #        if {!$skip} {
-        #            lappend folders $f
-        #        }
-        #    }
-        #} else {
-        #    set folders $all_subfolders
-        #}
-        #if {$do_recursion} {
-        #    foreach subdir $folders {
-        #        lappend folders {*}[subfolders -exclude-paths $exclude_paths -recursive $subdir]
-        #    }
-        #}
         return $folders
     }
 
-    #todo - treefolders with similar search caps as treefilenames
+    namespace eval subfolder_priv {
+        proc classify_exclude_pattern {pat} {
+            set parts [file split $pat]
+            if {[llength $parts] >= 2 && [lindex $parts end] eq "**"} {
+                set boundary_pat [file join {*}[lrange $parts 0 end-1]]
+                return [dict create \
+                    pattern $pat \
+                    kind subtree \
+                    boundary_pat $boundary_pat \
+                    descend_pat $pat]
+            }
+            if {[llength $parts] >= 2 && [lindex $parts end] eq "*"} {
+                return [dict create \
+                    pattern $pat \
+                    kind child_only \
+                    match_pat $pat]
+            }
+            return [dict create \
+                pattern $pat \
+                kind exact \
+                match_pat $pat]
+        }
+
+        proc compile_exclude_rules {exclude_paths} {
+            set rules [list]
+            foreach pat $exclude_paths {
+                lappend rules [classify_exclude_pattern $pat]
+            }
+            return $rules
+        }
+
+        proc match_rule_at_node {rule path} {
+            set kind [dict get $rule kind]
+            switch -- $kind {
+                exact - child_only {
+                    if {[::punk::path::globmatchpath [dict get $rule match_pat] $path]} {
+                        return [dict create include_current 0 recurse_below 1 child_rules [list $rule]]
+                    }
+                    return [dict create include_current 1 recurse_below 1 child_rules [list $rule]]
+                }
+                subtree {
+                    set descend_pat  [dict get $rule descend_pat]
+                    set boundary_pat [dict get $rule boundary_pat]
+                    if {[::punk::path::globmatchpath $descend_pat $path]} {
+                        return [dict create include_current 0 recurse_below 0 child_rules [list]]
+                    }
+                    if {[::punk::path::globmatchpath $boundary_pat $path]} {
+                        return [dict create include_current 1 recurse_below 0 child_rules [list]]
+                    }
+                    return [dict create include_current 1 recurse_below 1 child_rules [list $rule]]
+                }
+                default {
+                    error "Unknown exclude rule kind '$kind'"
+                }
+            }
+        }
+
+        proc walk_subfolders {path rules do_recursion} {
+            set all_subfolders [glob -nocomplain -directory $path -types d *]
+            set folders [list]
+            foreach f $all_subfolders {
+                set include_current 1
+                set recurse_below $do_recursion
+                set child_rules [list]
+                foreach rule $rules {
+                    set outcome [match_rule_at_node $rule $f]
+                    if {![dict get $outcome include_current]} {
+                        set include_current 0
+                    }
+                    if {![dict get $outcome recurse_below]} {
+                        set recurse_below 0
+                    }
+                    if {$do_recursion} {
+                        lappend child_rules {*}[dict get $outcome child_rules]
+                    }
+                    if {!$include_current && !$recurse_below} {
+                        break
+                    }
+                }
+                if {$include_current} {
+                    lappend folders $f
+                }
+                if {$do_recursion && $recurse_below} {
+                    lappend folders {*}[walk_subfolders $f $child_rules $do_recursion]
+                }
+            }
+            return $folders
+        }
+    }
 
     punk::args::define {
-        @id     -id     ::punk::path::treefilenames
+        @id     -id     ::punk::path::subfolders
-        @cmd    -name     punk::path::treefilenames\
+        @cmd    -name     punk::path::subfolders\
             -summary\
-            "List of filenames below supplied path."\
+            "Listing of directories below supplied path."\
             -help\
-            "List of filenames below path.
+            "List of folders below path.
-            The resulting list is unsorted."
+            The resulting list is unsorted.
-        -directory       -type directory  -help\
+            "
-            "folder in which to begin recursive scan for files."
+        @opts
-        -call-depth-internal    -default 0 -type integer -help "internal use only - caller should not specify - used to track depth of recursive calls for internal logic"
+        -recursive -type none -help\
-        -call-subvector         -default {} -type list -help "internal use only - caller should not specify - used to track path vector of recursive calls for internal logic"
+            ""
-        -call-allbelow          -default 1   -type boolean -help "internal use only - caller should not specify - used to track whether we are in a subtree below a match for glob_paths (which means we can skip glob matching and antiglob_paths checks and just include all files below here)" 
+        -exclude-paths -type list -default {} -help\
-        -sort -type any         -default natural -choices {none ascii dictionary natural}
+            "list of path patterns to exclude from results.
-        -antiglob_paths         -default {} -help\
+            May include * and ** path segments e.g /usr/**
-            "list of path patterns to exclude
+            A single /*/ will match any single segment in the path, and a single /**/ will match any number of segments in the path.
-              may include * and ** path segments e.g
-              /usr/**       (exclude subfolders based at /usr but not
-                             files within /usr itself)
-              **/_aside     (exclude  files where _aside is last segment)
-              **/_aside/*   (exclude folders one below an _aside folder)
-              **/_aside/**  (exclude all folders with _aside as a segment)"
-        -antiglob_files         -default {}
-        -glob_paths     -default {*} -help\
-            "list of path patterns to include
-              may include * and ** path segments e.g
-              /usr/**       (include subfolders based at /usr but not
-                             files within /usr itself)
-              **/_aside     (include  files where _aside is last segment)
-              **/_aside/*   (include folders one below an _aside folder)
-              **/_aside/**  (include all folders with _aside as a segment)"
-        @values -min 0 -max -1 -optional 1 -type string
-        tailglobs -default * -multiple 1   -help\
-            "Patterns to match against filename portion (last segment) of each file path
-              within the directory tree being searched."
-    }
 
-    #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/
+            e.g to exclude any path with _aside as a segment in the middle: -exclude-paths **/_aside/**
-    #then review if treefiles can replace dirfiles or if both should exist (dirfiles can have literal glob chars in path segments - but that is a rare usecase)
+            i.e this would exclude /usr/_aside/etc and /usr/x/_aside/etc but not /usr/x/_aside or _aside/etc
-    proc treefilenames {args} {
-        #*** !doctools
-        #[call [fun treefilenames]  [opt {option value...}] [opt {globpattern...}]]
-        #[para]basic (glob based) list of filenames matching each pattern in tailglobs - recursive
-        #[para] options:
-        #[para] [opt -dir] <path>
-        #[para]     defaults to [lb]pwd[rb] - base path for tree to search
-        #[para] [opt -antiglob_paths] <list>
-        #[para]     list of path patterns to exclude - may include * and ** path segments e.g /usr/**
-        #[para]no natsorting - so order is dependent on filesystem
 
-        set argd [punk::args::parse $args withid ::punk::path::treefilenames]
+            To exclude all paths with _aside as a segment anywhere: -exclude-paths { **/_aside/** **/_aside ./_aside/**}
+            "
+        #todo -depth
+        @values -min 0 -max 1
+        path -type directory -optional 1 -help\
+            "Path of base folder. If not supplied current directory is used.
+            This may be a relative or absolute path. Relative paths are treated as relative to current directory.
+            When using relative paths - the result will also be relative paths with the same relative prefix.
+            (e.g if path is ../test - the results will be ../test/subfolder1 ../test/subfolder2 etc)
+            Patterns in -exclude-paths are matched against the resulting paths
+            (so should be written to match the same relative prefix if path is relative)"
+    }
+
+    proc subfolders {args} {
+        set argd [punk::args::parse $args withid ::punk::path::subfolders]
         lassign [dict values $argd] leaders opts values received
-        set tailglobs [dict get $values tailglobs]
+        set do_recursion    [dict exists $received -recursive]
-        # -- --- --- --- --- --- ---
+        set exclude_paths   [dict get $opts -exclude-paths]
-        set opt_sort            [dict get $opts -sort]
+        if {"**" in $exclude_paths} {
-        set opt_antiglob_paths  [dict get $opts -antiglob_paths]
+            puts stderr "punk::path::subfolders Warning - exclude_paths contains '**' - all paths will be excluded"
-        set opt_glob_paths      [dict get $opts -glob_paths]
+            return [list]
-        set opt_antiglob_files  [dict get $opts -antiglob_files]
-
-        set CALLDEPTH           [dict get $opts -call-depth-internal]
-        set callsubvector       [dict get $opts -call-subvector]
-        set callallbelow        [dict get $opts -call-allbelow] ;#whether to return matches longer than the matched glob-path
-        # -- --- --- --- --- --- ---
-        # -- --- --- --- --- --- ---
-        if {"*" in $opt_glob_paths} {
-            #if we have a * in the default glob_paths - then any other entries are redundant.
-            set opt_glob_paths {*}
         }
+        if {[dict exists $received path]} {
+            set path [dict get $values path]
+        } else {
+            set path [pwd]
+        }
+        set compiled_rules [subfolder_priv::compile_exclude_rules $exclude_paths]
+        return [subfolder_priv::walk_subfolders $path $compiled_rules $do_recursion]
+    }
 
-        set files [list]
+    namespace eval treefile_priv {
-        if {$CALLDEPTH == 0} {
+        proc _pattern_prefix_viable_parts {pattern_parts path_parts} {
-            if {$opt_sort eq "natural"} {
+            if {![llength $path_parts]} {
-                package require natsort
+                return 1
-            }
-            #set opts [dict merge $opts [list -directory $opt_dir]]
-            if {[dict exists $received -directory]} {
-                set opt_dir [dict get $opts -directory]
-            } else {
-
-                set opt_dir [pwd]
             }
-            if {![file isdirectory $opt_dir]} {
+            if {![llength $pattern_parts]} {
-                return [list]
+                return 0
             }
 
+            set pattern_head [lindex $pattern_parts 0]
+            set path_head [lindex $path_parts 0]
 
-        } else {
+            if {$pattern_head eq "**"} {
-            #assume/require to exist in any recursive call
+                if {[_pattern_prefix_viable_parts [lrange $pattern_parts 1 end] $path_parts]} {
-            set opt_dir [dict get $opts -directory]
+                    return 1
+                }
+                return [_pattern_prefix_viable_parts $pattern_parts [lrange $path_parts 1 end]]
+            }
+
+            if {[::punk::path::globmatchpath $pattern_head $path_head]} {
+                return [_pattern_prefix_viable_parts [lrange $pattern_parts 1 end] [lrange $path_parts 1 end]]
+            }
+            return 0
         }
 
-        #comment out to compare timings with treefilenames_zipfs
+        proc pattern_prefix_viable {pattern path} {
-        if {[string match //zipfs:/* $opt_dir]} {
+            return [_pattern_prefix_viable_parts [file split $pattern] [file split $path]]
-            return [treefilenames_zipfs {*}$args]
         }
 
-        set skip 0
+        proc pattern_boundary {pattern} {
-        foreach anti $opt_antiglob_paths {
+            set parts [file split $pattern]
-            if {[globmatchpath $anti $opt_dir]} {
+            if {[llength $parts] >= 2 && [lindex $parts end] eq "**"} {
-                set skip 1
+                return [file join {*}[lrange $parts 0 end-1]]
-                break
             }
-        }
+            return ""
-        if {$skip} {
-            return [list]
         }
 
-        #todo - account for vfs where matched path could appear to be a directory but is mounted so could be a desired match?
+        proc directory_state {glob_paths path inherited_allbelow} {
-        if {[catch {glob -nocomplain -dir $opt_dir -type f {*}$tailglobs} matches]} {
+            if {$inherited_allbelow} {
-            #we can get for example a permissions error
+                return [dict create include_files 1 recurse_below 1 next_allbelow 1]
-            puts stderr "treefilenames error while listing files in dir $opt_dir\n $matches"
+            }
-            set dirfiles [list]
+
-        } else {
+            set include_files 0
-            set retained [list]
+            set recurse_below 0
-            if {[llength $opt_antiglob_files]} {
+            set next_allbelow 0
-                foreach m $matches {
+
-                    set skip 0
+            foreach gp $glob_paths {
-                    set ftail [file tail $m]
+                if {[::punk::path::globmatchpath $gp $path]} {
-                    foreach anti $opt_antiglob_files {
+                    set include_files 1
-                        if {[string match $anti $ftail]} {
+                    set recurse_below 1
-                            set skip 1; break
+                    set next_allbelow 1
-                        }
+                    break
-                    }
+                }
-                    if {!$skip} {
+
-                        lappend retained $m
+                set boundary [pattern_boundary $gp]
+                if {$boundary ne "" && [::punk::path::globmatchpath $boundary $path]} {
+                    set recurse_below 1
+                    set next_allbelow 1
+                    break
+                }
+
+                if {[pattern_prefix_viable $gp $path]} {
+                    set recurse_below 1
+                }
+            }
+
+            return [dict create                     {*}{
+                    } include_files $include_files  {*}{
+                    } recurse_below $recurse_below  {*}{
+                    } next_allbelow $next_allbelow  {*}{
                     }
+                ]
+        }
+
+        proc child_path_state {glob_paths child_path inherited_allbelow} {
+            if {$inherited_allbelow} {
+                return 1
+            }
+            foreach gp $glob_paths {
+                if {[pattern_prefix_viable $gp $child_path]} {
+                    return 1
                 }
-            } else {
-                set retained $matches
             }
-            switch -- $opt_sort {
+            return 0
+        }
+
+        proc _sort_paths {paths sortmode} {
+            switch -- $sortmode {
                 ascii {
-                    set dirfiles [lsort $retained]
+                    return [lsort $paths]
                 }
                 dictionary {
-                    set dirfiles [lsort -dictionary $retained]
+                    return [lsort -dictionary $paths]
                 }
                 natural {
-                    set dirfiles [natsort::sort $retained]
+                    return [natsort::sort $paths]
                 }
                 default {
-                    set dirfiles $retained
+                    return $paths
                 }
             }
         }
 
-        lappend files  {*}$dirfiles
+        proc _path_matches_any {patterns path} {
-        if {[catch {glob -nocomplain -dir $opt_dir -type d *} dirdirs]} {
+            foreach pattern $patterns {
-            puts stderr "treefilenames error while listing subdirs in dir $opt_dir\n $dirdirs"
+                if {[::punk::path::globmatchpath $pattern $path]} {
-            set dirdirs [list]
+                    return 1
-        }
-        set okdirs [list]
-        foreach dir $dirdirs {
-            set skip 0
-            foreach anti $opt_antiglob_paths {
-                if {[globmatchpath $anti $dir]} {
-                    set skip 1
-                    break
                 }
             }
-            if {!$skip} {
+            return 0
-                lappend okdirs $dir
+        }
+
+        proc _tailbase_relative {tailbase path} {
+            if {$tailbase eq ""} {
+                return $path
             }
+            return [::punk::path::relative $tailbase $path]
         }
-        if {$opt_glob_paths eq {*}} {
-            set matchdirs $okdirs
-        } else {
-            #** only significant when it is the trailing part of a segment eg /**/xxx  /a**/xxx
 
+        proc _tailbase_match_path {tailbase path} {
+            set match_path [_tailbase_relative $tailbase $path]
+            if {$match_path eq "."} {
+                return ""
+            }
+            return $match_path
+        }
 
+        proc _tailbase_relative_list {tailbase paths} {
+            if {$tailbase eq ""} {
+                return $paths
+            }
+            set relative_paths [list]
+            foreach path $paths {
+                lappend relative_paths [_tailbase_relative $tailbase $path]
+            }
+            return $relative_paths
+        }
 
-            set matchdirs [list]
+        proc _retain_files {matches exclude_files sortmode} {
-            foreach dir $okdirs {
+            set retained [list]
-                foreach gp $opt_glob_paths {
+            foreach match $matches {
-                    if {[globmatchpath $gp $dir] || [globmatchpath "$gp/**" $dir]} {
+                set skip 0
-                        lappend matchdirs $dir
+                set file_tail [file tail $match]
+                foreach anti $exclude_files {
+                    if {[string match $anti $file_tail]} {
+                        set skip 1
+                        break
                     }
                 }
+                if {!$skip} {
+                    lappend retained $match
+                }
             }
+            return [_sort_paths $retained $sortmode]
         }
-        if {[llength $matchdirs]} {
+
-            switch -- $opt_sort {
+        proc _state_from_argd {argd} {
-                ascii {
+            set opts        [dict get $argd opts]
-                    set finaldirs [lsort $matchdirs]
+            set values      [dict get $argd values]
+            set received    [dict get $argd received]
+
+            if {[dict exists $received -directory]} {
+                set directory [dict get $opts -directory]
+            } else {
+                set directory [pwd]
+            }
+
+            set glob_paths [dict get $opts -include-paths]
+            if {"*" in $glob_paths} {
+                set glob_paths {*}
+            }
+
+            set sortmode [dict get $opts -sort]
+            if {$sortmode eq "natural"} {
+                package require natsort
+            }
+
+            return [dict create {*}{
+                    depth           0
+                    subvector       {}
+                    allbelow        0
+                }   sort            $sortmode                             {*}{
+                }   directory       $directory                            {*}{
+                }   tailbase        [dict get $opts -tailbase]            {*}{
+                }   exclude_paths   [dict get $opts -exclude-paths]       {*}{
+                }   exclude_files   [dict get $opts -exclude-files]       {*}{
+                }   glob_paths      $glob_paths                           {*}{
+                }   tailglobs       [dict get $values tailglobs]          {*}{
                 }
-                dictionary {
+            ]
-                    set finaldirs [lsort -dictionary $matchdirs]
+        }
+
+        proc walk_treefilenames {state} {
+            set opt_dir             [dict get $state directory]
+            set opt_tailbase        [dict get $state tailbase]
+            set depth               [dict get $state depth]
+            set subvector           [dict get $state subvector]
+            set callallbelow        [dict get $state allbelow]
+            set opt_sort            [dict get $state sort]
+            set opt_exclude_paths   [dict get $state exclude_paths]
+            set opt_exclude_files   [dict get $state exclude_files]
+            set opt_glob_paths      [dict get $state glob_paths]
+            set tailglobs           [dict get $state tailglobs]
+
+            if {![file isdirectory $opt_dir]} {
+                return [list]
+            }
+            if {[string match //zipfs:/* $opt_dir]} {
+                return [walk_treefilenames_zipfs $state]
+            }
+            set opt_dir_match [_tailbase_match_path $opt_tailbase $opt_dir]
+            if {[_path_matches_any $opt_exclude_paths $opt_dir_match]} {
+                return [list]
+            }
+
+            set files [list]
+            set dir_state [directory_state $opt_glob_paths $opt_dir_match $callallbelow]
+            if {[dict get $dir_state include_files]} {
+                if {[catch {glob -nocomplain -dir $opt_dir -type f {*}$tailglobs} matches]} {
+                    puts stderr "treefilenames error while listing files in dir $opt_dir\n $matches"
+                    set dirfiles [list]
+                } else {
+                    set dirfiles [_retain_files $matches $opt_exclude_files $opt_sort]
                 }
-                natural {
+                lappend files {*}[_tailbase_relative_list $opt_tailbase $dirfiles]
-                    set finaldirs [natsort::sort $matchdirs]
+            }
+
+            if {![dict get $dir_state recurse_below]} {
+                return $files
+            }
+
+            if {[catch {glob -nocomplain -dir $opt_dir -type d *} dirdirs]} {
+                puts stderr "treefilenames error while listing subdirs in dir $opt_dir\n $dirdirs"
+                set dirdirs [list]
+            }
+            set okdirs [list]
+            foreach dir $dirdirs {
+                if {![_path_matches_any $opt_exclude_paths [_tailbase_match_path $opt_tailbase $dir]]} {
+                    lappend okdirs $dir
                 }
-                default {
+            }
-                    set finaldirs $matchdirs
+
+            if {$opt_glob_paths eq "*"} {
+                set matchdirs $okdirs
+            } else {
+                set matchdirs [list]
+                foreach dir $okdirs {
+                    if {$callallbelow || [child_path_state $opt_glob_paths [_tailbase_match_path $opt_tailbase $dir] $callallbelow]} {
+                        lappend matchdirs $dir
+                    }
                 }
             }
+
+            set finaldirs [_sort_paths $matchdirs $opt_sort]
+            set childallbelow [expr {$callallbelow || [dict get $dir_state next_allbelow]}]
+            set nextsubvector [list {*}$subvector [file tail $opt_dir]]
             foreach dir $finaldirs {
-                set nextopts [dict merge $opts [list -directory $dir -call-depth-internal [incr CALLDEPTH]]]
+                set child_state [dict merge $state [dict create {*}{} \
-                lappend files {*}[treefilenames {*}$nextopts {*}$tailglobs]
+                    directory   $dir \
+                    depth       [expr {$depth + 1}] \
+                    subvector   $nextsubvector \
+                    allbelow    $childallbelow]]
+                lappend files {*}[walk_treefilenames $child_state]
             }
+            return $files
         }
-        return $files
+
-    }
+        proc walk_treefilenames_zipfs {state} {
-    proc treefilenames_zipfs {args} {
+            set opt_dir             [dict get $state directory]
-        #seems to be 2 or 3 times faster than treefilenames for //zipfs:/ paths  - REVIEW
+            set opt_tailbase        [dict get $state tailbase]
-        # is sort order the same?
+            set opt_exclude_paths   [dict get $state exclude_paths]
-        set argd [punk::args::parse $args withid ::punk::path::treefilenames]
+            set opt_exclude_files   [dict get $state exclude_files]
-        lassign [dict values $argd] leaders opts values received
+            set opt_glob_paths      [dict get $state glob_paths]
-        set tailglobs [dict get $values tailglobs]
+            set opt_sort            [dict get $state sort]
-        # -- --- --- --- --- --- ---
+            set tailglobs           [dict get $state tailglobs]
-        set opt_antiglob_paths [dict get $opts -antiglob_paths]
+
-        set opt_antiglob_files [dict get $opts -antiglob_files]
+            if {![string match [zipfs root]* $opt_dir]} {
-        set opt_sort           [dict get $opts -sort]
+                error "treefilenames_zipfs can only be used on paths beginning with [zipfs root] on this systems"
-        set CALLDEPTH [dict get $opts -call-depth-internal]
-        # -- --- --- --- --- --- ---
-        # -- --- --- --- --- --- ---
-
-        set files [list]
-        if {$CALLDEPTH == 0} {
-            if {$opt_sort eq "natural"} {
-                package require natsort
-            }
-            #set opts [dict merge $opts [list -directory $opt_dir]]
-            if {![dict exists $received -directory]} {
-                set opt_dir [pwd]
-            } else {
-                set opt_dir [dict get $opts -directory]
             }
-            if {![file isdirectory $opt_dir]} {
+            set dir [string trimright $opt_dir "/"]
+            if {[_path_matches_any $opt_exclude_paths [_tailbase_match_path $opt_tailbase $dir]]} {
                 return [list]
             }
-        } else {
+            set dirlen [string length $dir]
-            #assume/require to exist in any recursive call
+            set subpaths [zipfs list $dir/*]
-            set opt_dir [dict get $opts -directory]
+            set dirlist [list]
-        }
+            set skipdirs [list]
-        if {![string match [zipfs root]* $opt_dir]} {
+            set filelist [list]
-            error "treefilenames_zipfs can only be used on paths beginning with [zipfs root] on this systems"
+            foreach sub $subpaths {
-        }
+                set tail [string range $sub $dirlen+1 end]
-        set dir [string trimright $opt_dir "/"] ;#e.g normalize //zipfs:/x/ to //zipfs:/x
+                set tailparts [file split $tail]
-        set dirlen [string length $dir]
+                set accum ""
-
+                set skipdir 0
-        set skip 0
+                foreach tailpart [lrange $tailparts 0 end-1] {
-        foreach anti $opt_antiglob_paths {
+                    append accum "/$tailpart"
-            if {[globmatchpath $anti $dir]} {
+                    set superpath "${dir}${accum}"
-                set skip 1
+                    if {$superpath in $skipdirs} {
-                break
+                        set skipdir 1
-            }
+                        break
-        }
+                    }
-        if {$skip} {
+                    if {$superpath ni $dirlist} {
-            return [list]
+                        if {[_path_matches_any $opt_exclude_paths [_tailbase_match_path $opt_tailbase $superpath]]} {
-        }
-        set subpaths [zipfs list $dir/*]
-        set dirlist [list]
-        set skipdirs [list]
-        set filelist [list]
-        #process in the order they came - sorting large list more expensive?? review
-        foreach sub $subpaths {
-            set tail [string range $sub $dirlen+1 end] ;#dirlen is without trailing slash
-            set tailparts [file split $tail]
-            set accum ""
-            set skipdir 0
-            foreach tp [lrange $tailparts 0 end-1] {
-                append accum "/$tp"
-                set superpath "${dir}${accum}"
-                if {$superpath in $skipdirs} {
-                    #subpart already in skipdirs
-                    set skipdir 1
-                    break
-                }
-                if {$superpath ni $dirlist} {
-                    set skip2 0
-                    foreach anti $opt_antiglob_paths {
-                        if {[globmatchpath $anti $superpath]} {
-                            set skip2 1
                             lappend skipdirs $superpath
+                            set skipdir 1
                             break
+                        } else {
+                            lappend dirlist $superpath
                         }
                     }
-                    if {!$skip2} {
-                        lappend dirlist $superpath
-                    } else {
-                        set skipdir 1
-                        break
-                    }
                 }
-            }
+                if {!$skipdir} {
-            if {!$skipdir} {
+                    append accum "/[lindex $tailparts end]"
-                #process final part of path
+                    set finalpart "${dir}${accum}"
-                append accum "/[lindex $tailparts end]"
+                    if {$finalpart ni $dirlist} {
-                set finalpart "${dir}${accum}"
+                        if {[file type $finalpart] eq "file"} {
-                if {$finalpart ni $dirlist} {
+                            set file_tail [lindex $tailparts end]
-                    if {[file type $finalpart] eq "file"} {
+                            set match 0
-                        set ftail [lindex $tailparts end]
+                            if {"*" ni $tailglobs} {
-                        set match 0
+                                foreach tailglob $tailglobs {
-                        if {"*" ni $tailglobs} {
+                                    if {[string match $tailglob $file_tail]} {
-                            foreach tg $tailglobs {
+                                        set match 1
-                                if {[string match $tg $ftail]} {
+                                        break
-                                    set match 1
+                                    }
-                                    break
                                 }
+                            } else {
+                                set match 1
                             }
-                        } else {
+                            if {$match} {
-                            set match 1
+                                if {$opt_glob_paths ne "*"} {
-                        }
+                                    set file_dir_match [_tailbase_match_path $opt_tailbase [file dirname $finalpart]]
-                        if {$match} {
+                                    set file_dir_state [directory_state $opt_glob_paths $file_dir_match 0]
-                            if {[llength $opt_antiglob_files]} {
+                                    set match [dict get $file_dir_state include_files]
+                                }
+                            }
+                            if {$match} {
                                 set skipfile 0
-                                foreach anti $opt_antiglob_files {
+                                foreach anti $opt_exclude_files {
-                                    if {[string match $anti $ftail]} {
+                                    if {[string match $anti $file_tail]} {
-                                        set skipfile 1; break
+                                        set skipfile 1
+                                        break
                                     }
                                 }
                                 if {!$skipfile} {
-                                    lappend filelist $finalpart
+                                    lappend filelist [_tailbase_relative $opt_tailbase $finalpart]
                                 }
-                            } else {
-                                lappend filelist $finalpart
                             }
-                        }
+                        } else {
-                    } else {
+                            if {$finalpart ni $dirlist} {
-                        if {$finalpart ni $dirlist} {
+                                if {[_path_matches_any $opt_exclude_paths [_tailbase_match_path $opt_tailbase $finalpart]]} {
-                            set skip2 0
-                            foreach anti $opt_antiglob_paths {
-                                if {[globmatchpath $anti $finalpart]} {
-                                    set skip2 1
                                     lappend skipdirs $finalpart
-                                    break
+                                } else {
+                                    lappend dirlist $finalpart
                                 }
                             }
-                            if {!$skip2} {
-                                lappend dirlist $finalpart
-                            }
                         }
                     }
                 }
             }
+            return [_sort_paths $filelist $opt_sort]
         }
-        switch -- $opt_sort {
+    }
-            ascii {
+
-                set finalfilelist [lsort $filelist]
+    #todo - treefolders with similar search caps as treefilenames
-            }
+
-            dictionary {
+    punk::args::define {
-                set finalfilelist [lsort -dictionary $filelist]
+        @id     -id     ::punk::path::treefilenames
-            }
+        @cmd    -name     punk::path::treefilenames\
-            natural {
+            -summary\
-                set finalfilelist [natsort::sort $filelist]
+            "List of filenames below supplied path."\
-            }
+            -help\
-            default {
+            "List of filenames below path.
-                set finalfilelist $filelist
+            The resulting list is unsorted.
-            }
+
+            The path globbing syntax supports *, ** and ? as glob characters in any segment of the path, with the following semantics:
+            * matches any single segment in the path
+            ** matches 1 or more segments in the path (so /usr/**/bin will match /usr/x/bin and user/x/y/bin but not /usr/bin )
+            ? matches any single character in a single segment of the path (so /usr/te?t will match /usr/test and /usr/text but not /usr/texxt)
+            "
+        -directory       -type directory  -help\
+            "folder in which to begin recursive scan for files."
+        -tailbase         -type string    -default "" -help\
+            "if supplied, only the relative path compared to the tailbase will be returned for each file.
+            So if tailbase is /usr and a file is found at /usr/x/y/file.txt, the returned path for that file would be x/y/file.txt.
+            If tailbase is not supplied, the full path to each file will be returned.
+
+            If tailbase is supplied, it should be a prefix of the directory supplied (or the directory itself)
+            The patterns in -exclude-paths should be written to match the returned paths (i.e with the tailbase prefix removed) if -tailbase is supplied.
+            If the tailbase is not a prefix of the directory supplied, the resulting paths may have /../ components in them to account for the difference,
+            but the behaviour is not well defined in this case and it is recommended to ensure tailbase is a prefix of the directory supplied if using -tailbase.
+
+            see: punk::path::relative to compute relative paths
+            "
+        -sort -type any         -default natural -choices {none ascii dictionary natural}
+        -exclude-paths         -default {} -help\
+            "list of path patterns to exclude
+              may include * and ** path segments e.g
+              /usr/**       (exclude subfolders based at /usr but not
+                             files within /usr itself)
+              **/_aside     (exclude  files where _aside is last segment)
+              **/_aside/*   (exclude folders one below an _aside folder)
+              **/_aside/**  (exclude files in all folders with _aside as a segment)"
+        -exclude-files         -default {}
+        -include-paths     -default {**} -help\
+            "list of path patterns to include
+              may include * and ** path segments e.g
+              /usr/**       (include files in subfolders based at /usr but not
+                             files within /usr itself)
+              **/_aside     (include  files where _aside is last segment in the folder)
+              **/_aside/*   (include files in folders one below an _aside folder)
+              **/_aside/**  (include all files in folders with _aside as a segment)"
+        @values -min 0 -max -1 -optional 1 -type string
+        tailglobs -default * -multiple 1   -help\
+            "Patterns to match against filename portion (last segment) of each file path
+              within the directory tree being searched."
+    }
+
+    #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/
+    #then review if treefiles can replace dirfiles or if both should exist (dirfiles can have literal glob chars in path segments - but that is a rare usecase)
+    proc treefilenames {args} {
+        set argd [punk::args::parse $args withid ::punk::path::treefilenames]
+        set state [treefile_priv::_state_from_argd $argd]
+        return [treefile_priv::walk_treefilenames $state]
+    }
+    punk::args::set_idalias ::punk::path::treefilenames_zipfs ::punk::path::treefilenames
+    proc treefilenames_zipfs {args} {
+        #seems to be 2 or 3 times faster than treefilenames for //zipfs:/ paths  - REVIEW
+        # is sort order the same?
+        set argd [punk::args::parse $args withid ::punk::path::treefilenames]
+        set state [treefile_priv::_state_from_argd $argd]
+        if {![file isdirectory [dict get $state directory]]} {
+            return [list]
         }
-        return $finalfilelist
+        return [treefile_priv::walk_treefilenames_zipfs $state]
     }
 
     #maint warning - also in punkcheck

src/modules/punkcheck-999999.0a1.0.tm

@@ -41,9 +41,9 @@ namespace eval punkcheck {
             summarize_install_resultdict
         }
 
-        #antiglob_dir & antiglob_file entries match the pattern at any level - should not contain path separators
+        #exclude-dir & exclude-file entries match the pattern at any level - should not contain path separators
-        variable default_antiglob_dir_core  [list "#*" "_aside" "_build" ".git" ".fossil*"]
+        variable default_exludedirseg_core  [list "#*" "_aside" "_build" ".git" ".fossil*"]
-        variable default_antiglob_file_core ""
+        variable default_excludefiletail_core ""
 
         set has_twapi 0
         if {"windows" eq $::tcl_platform(platform)} {
@@ -56,16 +56,16 @@ namespace eval punkcheck {
             interp alias "" ::punkcheck::uuid "" ::uuid::uuid generate
         }
 
-        proc default_antiglob_dir_core {} {
+        proc default_excludedirseg_core {} {
-            variable default_antiglob_dir_core
+            variable default_excludedirseg_core
-            return $default_antiglob_dir_core
+            return $default_excludedirseg_core
         }
-        proc default_antiglob_file_core {} {
+        proc default_excludefiletail_core {} {
-            variable default_antiglob_file_core
+            variable default_excludefiletail_core
-            if {$default_antiglob_file_core eq ""} {
+            if {$default_excludefiletail_core eq ""} {
-                set default_antiglob_file_core [list "*.swp" "*[punk::mix::util::magic_tm_version]*" "*-buildversion.txt" ".punkcheck"]
+                set default_excludefiletail_core [list "*.swp" "*[punk::mix::util::tm_version_magic]*" "*-buildversion.txt" ".punkcheck"]
             }
-            return $default_antiglob_file_core
+            return $default_excludefiletail_core
         }
 
 
@@ -1268,7 +1268,7 @@ namespace eval punkcheck {
             set defaults [list {*}{
                     -glob           *.tm
                     -installer      punkcheck::install_tm_files
-                }   -antiglob_file  [list "*[punk::mix::util::magic_tm_version]*"] {*}{
+                }   -exclude-filetails  [list "*[punk::mix::util::tm_version_magic]*"] {*}{
                 }
                 ]
             set opts [dict merge $defaults $args]
@@ -1276,17 +1276,16 @@ namespace eval punkcheck {
         }
         proc install_non_tm_files {srcdir basedir args} {
             #set keys [dict keys $args]
-            #adjust the default antiglob_dir_core entries so that .fossil-custom, .fossil-settings are copied
+            #adjust the default excludedirseg_core entries so that .fossil-custom, .fossil-settings are copied
-            set antiglob_dir_core [punkcheck::default_antiglob_dir_core]
+            set excludedirseg_core [punkcheck::default_excludedirseg_core]
-            set posn [lsearch $antiglob_dir_core ".fossil*"]
+            set posn [lsearch $excludedirseg_core ".fossil*"]
             if {$posn >=0} {
-                #set antiglob_dir_core [lreplace $antiglob_dir_core $posn $posn]
+                ledit excludedirseg_core $posn $posn
-                set antiglob_dir_core [lreplace $antiglob_dir_core[set antiglob_dir_core {}] $posn $posn]
             }
             set defaults [list  {*}{
                 }   -glob               *                                           {*}{
-                }   -antiglob_file      [list "*.tm" "*-buildversion.txt" "*.exe"]  {*}{
+                }   -exclude-filetails  [list "*.tm" "*-buildversion.txt" "*.exe"]  {*}{
-                }   -antiglob_dir_core  $antiglob_dir_core                          {*}{
+                }   -exclude-dirsegment_core  $excludedirseg_core                          {*}{
                 }   -installer          punkcheck::install_non_tm_files             {*}{
                 }
             ]
@@ -1334,10 +1333,10 @@ namespace eval punkcheck {
                 "Whether to create folders at target that had no matches for our glob"
             -glob -type string -default "*" -help\
                 "Pattern matching for source file(s) to copy. Can be glob based or exact match."
-            -antiglob_file_core -default {${[::punkcheck::default_antiglob_file_core]}}
+            -exclude-filetails_core -default {${[::punkcheck::default_excludefiltail_core]}}
-            -antiglob_file -default ""
+            -exclude-filetails -default ""
-            -antiglob_dir_core -default  {${[::punkcheck::default_antiglob_dir_core]}}
+            -exclude-dirsegments_core -default  {${[::punkcheck::default_excludedirseg_core]}}
-            -antiglob_dir -default ""
+            -exclude-dirsegments -default ""
             -antiglob_paths -default {}
             -overwrite      -default no-targets\
                 -choices {no-targets newer-targets older-targets all-targets installedsourcechanged-targets synced-targets}\
@@ -1417,10 +1416,10 @@ namespace eval punkcheck {
                 -createdir              0
                 -createempty            0
                 -glob                   *
-                -antiglob_file_core     "\uFFFF"
+                -exclude-filetails_core "\uFFFF"
-                -antiglob_file          ""
+                -exclude-filetails      ""
-                -antiglob_dir_core      "\uFFFF"
+                -exclude-dirsegments_core      "\uFFFF"
-                -antiglob_dir           {}
+                -exclude-dirsegments    {}
                 -antiglob_paths         {}
                 -overwrite              no-targets
                 -source_checksum        comparestore
@@ -1475,31 +1474,31 @@ namespace eval punkcheck {
                 #now the values we build from these will be properly cased
             }
             # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
-            set opt_antiglob_file_core                  [dict get $opts -antiglob_file_core]
+            set opt_excludefiletail_core                  [dict get $opts -exclude-filetails_core]
-            if {$opt_antiglob_file_core eq "\uFFFF"} {
+            if {$opt_excludefiletail_core eq "\uFFFF"} {
-                set opt_antiglob_file_core [default_antiglob_file_core]
+                set opt_excludefiletail_core [default_excludefiletail_core]
-                dict set opts -antiglob_file_core $opt_antiglob_file_core
+                dict set opts -exclude-filetails_core $opt_excludefiletail_core
             }
             # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
-            set opt_antiglob_file                       [dict get $opts -antiglob_file]
+            set opt_excludefiletail                      [dict get $opts -exclude-filetails]
             #validate no path seps
-            foreach af $opt_antiglob_file {
+            foreach af $opt_excludefiletail {
                 if {[llength [file split $af]] > 1} {
-                    error "punkcheck::install received invalid -antiglob_file entry '$af'. -antiglob_file entries are meant to match to a file name at any level so cannot contain path separators"
+                    error "punkcheck::install received invalid -exclude-filetails entry '$af'. -exclude-filetails entries are meant to match to a file name at any level so cannot contain path separators"
                 }
             }
             # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
-            set opt_antiglob_dir_core                   [dict get $opts -antiglob_dir_core]
+            set opt_excludedirseg_core                   [dict get $opts -exclude-dirsegments_core]
-            if {$opt_antiglob_dir_core eq "\uFFFF"} {
+            if {$opt_excludedirseg_core eq "\uFFFF"} {
-                set opt_antiglob_dir_core [default_antiglob_dir_core]
+                set opt_excludedirseg_core [default_excludedirseg_core]
-                dict set opts -antiglob_dir_core $opt_antiglob_dir_core
+                dict set opts -exclude-dirsegments_core $opt_excludedirseg_core
             }
             # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
-            set opt_antiglob_dir                        [dict get $opts -antiglob_dir]
+            set opt_excludedirseg                       [dict get $opts -exclude-dirsegments]
             #validate no path seps
-            foreach ad $opt_antiglob_dir {
+            foreach ad $opt_excludedirseg {
                 if {[llength [file split $ad]] > 1} {
-                    error "punkcheck::install received invalid -antiglob_dir entry '$ad'. -antiglob_dir entries are meant to match to a directory name at any level so cannot contain path separators"
+                    error "punkcheck::install received invalid -exclude-dirsegments entry '$ad'. -exclude-dirsegments entries are meant to match to a directory name at any level so cannot contain path separators"
                 }
             }
             # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
@@ -1655,7 +1654,7 @@ namespace eval punkcheck {
             set match_list [list]
             foreach m $candidate_list {
                 set suppress 0
-                foreach anti [concat $opt_antiglob_file_core $opt_antiglob_file] {
+                foreach anti [concat $opt_excludefiletail_core $opt_excludefiletail] {
                     if {[string match $anti $m]} {
                         #puts stderr "anti: $anti  vs m:$m"
                         set suppress 1
@@ -1970,9 +1969,9 @@ namespace eval punkcheck {
             #puts stderr "subdirs: $subdirs"
             foreach d $subdirs {
                 set skipd 0
-                foreach dg [concat $opt_antiglob_dir_core $opt_antiglob_dir] {
+                foreach dg [concat $opt_excludedirseg_core $opt_excludedirseg] {
                     if {[string match $dg $d]} {
-                        #puts stdout "SKIPPING FOLDER $d due to antiglob_dir-match: $dg "
+                        #puts stdout "SKIPPING FOLDER $d due to excludedirseg-match: $dg "
                         set skipd 1
                         break
                     }
@@ -2002,19 +2001,19 @@ namespace eval punkcheck {
 
 
                 set sub_opts_1 [list {*}{
-                    } -call-depth-internal    [expr {$CALLDEPTH + 1}]   {*}{
+                    } -call-depth-internal      [expr {$CALLDEPTH + 1}]   {*}{
-                    } -subdirlist             [list {*}$subdirlist $d]  {*}{
+                    } -subdirlist               [list {*}$subdirlist $d]  {*}{
-                    } -glob                   $fileglob                 {*}{
+                    } -glob                     $fileglob                 {*}{
-                    } -antiglob_file_core     $opt_antiglob_file_core   {*}{
+                    } -exclude-filetails_core   $opt_excludefiletail_core {*}{
-                    } -antiglob_file          $opt_antiglob_file        {*}{
+                    } -exclude-filetails        $opt_excludefiletail      {*}{
-                    } -antiglob_dir_core      $opt_antiglob_dir_core    {*}{
+                    } -exclude-dirsegments_core $opt_excludedirseg_core   {*}{
-                    } -antiglob_dir           $opt_antiglob_dir         {*}{
+                    } -exclude-dirsegments      $opt_excludedirseg        {*}{
-                    } -overwrite              $overwrite_what           {*}{
+                    } -overwrite                $overwrite_what           {*}{
-                    } -source_checksum        $opt_source_checksum      {*}{
+                    } -source_checksum          $opt_source_checksum      {*}{
-                    } -punkcheck_folder       $punkcheck_folder         {*}{
+                    } -punkcheck_folder         $punkcheck_folder         {*}{
-                    } -punkcheck_eventid      $punkcheck_eventid        {*}{
+                    } -punkcheck_eventid        $punkcheck_eventid        {*}{
-                    } -punkcheck_records      $punkcheck_records        {*}{
+                    } -punkcheck_records        $punkcheck_records        {*}{
-                    } -installer              $opt_installer            {*}{
+                    } -installer                $opt_installer            {*}{
                     }
                 ]
                 set sub_opts [list {*}{

src/modules/shellfilter-999999.0a1.0.tm

@@ -326,18 +326,34 @@ namespace eval shellfilter::chan {
         #method flush {ch} {
         #    return ""
         #}
+        #method flush {transform_handle} {
+        #    #puts stdout "<flush>"
+        #    #review - just clear o_encbuf and emit nothing?
+        #    #we wouldn't have a value there if it was convertable from the channel encoding?
+        #    if {[string length $o_encbuf]} {
+        #        #if we have data in the buffer that we haven't been able to convert to a string
+        #        #- then we probably have some kind of encoding mismatch. Is it safer to discard it than to emit garbage chars to the channel or var?
+        #        #REVIEW - log that we are discarding the buffer contents on flush?
+        #        puts stderr "WARNING: flush called on tee_to_var with non-empty buffer. This probably indicates an encoding mismatch between the channel encoding and the encoding expected by the transform. Discarding buffer contents: '$o_encbuf'"
+        #    }
+        #    set clear $o_encbuf
+        #    set o_encbuf ""
+        #    return $clear
+        #}
         method flush {transform_handle} {
-            #puts stdout "<flush>"
+            #puts stderr "<flush> $transform_handle o_encbuf: '$o_encbuf' datavars: $o_datavars"
-            #review - just clear o_encbuf and emit nothing?
+            set clear $o_encbuf
-            #we wouldn't have a value there if it was convertable from the channel encoding?
+            if {[catch {tcl::encoding::convertfrom $o_enc $clear} stringdata]} {
-            if {[string length $o_encbuf]} {
+                #if we can't convert the buffer contents to a string - does it make sense to emit the raw bytes?
-                #if we have data in the buffer that we haven't been able to convert to a string
+                # - probably not.
-                #- then we probably have some kind of encoding mismatch. Is it safer to discard it than to emit garbage chars to the channel or var?
+                #REVIEW?
-                #REVIEW - log that we are discarding the buffer contents on flush?
+                return ""
-                puts stderr "WARNING: flush called on tee_to_var with non-empty buffer. This probably indicates an encoding mismatch between the channel encoding and the encoding expected by the transform. Discarding buffer contents: '$o_encbuf'"
             }
             set o_encbuf ""
-            return ""
+            foreach v $o_datavars {
+                append $v $stringdata
+            }
+            return $stringdata
         }
         method write {ch bytes} {
             #test with set x [string repeat " \U1f6c8" 2043]
@@ -442,16 +458,29 @@ namespace eval shellfilter::chan {
         #    flush $o_localchan
         #    return $clear
         #}
+        #method flush {transform_handle} {
+        #    #we wouldn't have a value in o_encbuf if it was convertable from the channel encoding?
+        #    if {[string length $o_encbuf]} {
+        #        #if we have data in the buffer that we haven't been able to convert to a string
+        #        #- then we probably have some kind of encoding mismatch. Is it safer to discard it than to emit garbage chars to the channel or var?
+        #        #REVIEW - log that we are discarding the buffer contents on flush?
+        #        puts stderr "WARNING: flush called on tee_to_pipe with non-empty buffer. This probably indicates an encoding mismatch between the channel encoding and the encoding expected by the transform. Discarding buffer contents: '$o_encbuf'"
+        #    }
+        #    set clear $o_encbuf
+        #    set o_encbuf ""
+        #    return $clear
+        #}
         method flush {transform_handle} {
-            #we wouldn't have a value in o_encbuf if it was convertable from the channel encoding?
+            set clear $o_buffered$o_encbuf
-            if {[string length $o_encbuf]} {
+            if {[catch {tcl::encoding::convertfrom $o_enc $clear} stringdata]} {
-                #if we have data in the buffer that we haven't been able to convert to a string
+                #if we can't convert the buffer contents to a string - does it make sense to emit the raw bytes?
-                #- then we probably have some kind of encoding mismatch. Is it safer to discard it than to emit garbage chars to the channel or var?
+                # - probably not.
-                #REVIEW - log that we are discarding the buffer contents on flush?
+                #REVIEW?
-                puts stderr "WARNING: flush called on tee_to_pipe with non-empty buffer. This probably indicates an encoding mismatch between the channel encoding and the encoding expected by the transform. Discarding buffer contents: '$o_encbuf'"
+                return ""
             }
+            set o_buffered ""
             set o_encbuf ""
-            return ""
+            return $stringdata
         }
         method write {transform_handle bytes} {
             #set logdata [tcl::encoding::convertfrom $o_enc $bytes]
@@ -533,11 +562,24 @@ namespace eval shellfilter::chan {
             ::shellfilter::log::write $o_logsource $logdata
             return  $bytes
         }
+        #method flush {transform_handle} {
+        #    #return ""
+        #    set clear $o_encbuf
+        #    set o_encbuf ""
+        #    #review
+        #    return $clear
+        #}
         method flush {transform_handle} {
-            #return ""
+            set clear $o_buffered$o_encbuf
-            set clear $o_encbuf
+            if {[catch {tcl::encoding::convertfrom $o_enc $clear} stringdata]} {
+                #if we can't convert the buffer contents to a string - does it make sense to emit the raw bytes?
+                # - probably not.
+                #REVIEW?
+                return ""
+            }
+            set o_buffered ""
             set o_encbuf ""
-            return $o_encbuf
+            return $stringdata
         }
         method write {ch bytes} {
             #set logdata [tcl::encoding::convertfrom $o_enc $bytes]
@@ -613,9 +655,21 @@ namespace eval shellfilter::chan {
             my destroy
         }
         #clear?
+        #method flush {transform_handle} {
+        #    #we wouldn't have a value in o_encbuf if it was convertable from the channel encoding?
+        #    if {[string length $o_encbuf]} {
+        #        #if we have data in the buffer that we haven't been able to convert to a string
+        #        #- then we probably have some kind of encoding mismatch. Is it safer to discard it than to emit garbage chars to the log?
+        #        #REVIEW. - we are writing the raw bytes to the log here because we can't convert them to a string.
+        #        #This may be useful for debugging issues, but it may also result in garbage data in the log.
+        #        ::shellfilter::log::write $o_logsource $o_encbuf
+        #        set o_encbuf ""
+        #    }
+        #    return
+        #}
         method flush {transform_handle} {
-            #we wouldn't have a value in o_encbuf if it was convertable from the channel encoding?
+            set clear $o_buffered$o_encbuf
-            if {[string length $o_encbuf]} {
+            if {[catch {tcl::encoding::convertfrom $o_enc $clear} stringdata]} {
                 #if we have data in the buffer that we haven't been able to convert to a string
                 #- then we probably have some kind of encoding mismatch. Is it safer to discard it than to emit garbage chars to the log?
                 #REVIEW. - we are writing the raw bytes to the log here because we can't convert them to a string.
@@ -755,6 +809,110 @@ namespace eval shellfilter::chan {
         }
     }
 
+
+    #experimental
+    #applying this to stdout breaks console query/responses - why?
+    #- probably because we are splitting graphemes across writes and flushes and the console doesn't know how to handle that?
+    oo::class create unicode_normalize {
+        variable o_trecord
+        variable o_enc
+        variable o_encbuf
+        variable o_graphemebuf
+        variable o_mode
+        variable o_is_junction
+        constructor {tf} {
+            package require punk::ansi
+            set o_trecord $tf
+            set o_enc [::tcl::dict::get $tf -encoding]
+            set o_encbuf ""
+            set o_graphemebuf ""
+            set settingsdict [tcl::dict::get $tf -settings]
+            if {[dict exists $settingsdict -mode]} {
+                set o_mode [dict get $settingsdict -mode]
+                if {$o_mode ni {nfc nfd nfkc nfkd none}} {
+                    error "unicode_normalize transform - invalid mode '$o_mode' in settings"
+                }
+                if {$o_mode ne "none"} {
+                    #we get dll dependent load errors on windows sometimes - but still seems to work - REVIEW/FIX.
+                    catch {::tcl::unsupported::loadIcu}
+                }
+            } else {
+                #if no mode specified - default to 'none' which just does grapheme splitting without any unicode normalization
+                set o_mode "none"
+            }
+            if {[::tcl::dict::exists $tf -junction]} {
+                set o_is_junction [::tcl::dict::get $tf -junction]
+            } else {
+                set o_is_junction 0
+            }
+        }
+        method initialize {transform_handle mode} {
+            return [list initialize write flush finalize]
+        }
+        method finalize {transform_handle} {
+            my destroy
+        }
+        method flush {transform_handle} {
+            #flush seems to do nothing - why?
+            set clear $o_encbuf[unset o_encbuf]
+            if {[catch {tcl::encoding::convertfrom $o_enc $clear} stringdata]} {
+                #if we can't convert the buffer contents to a string - put it back and try again with more data later
+                #REVIEW?
+                set o_encbuf $clear
+                return ""
+            }
+            #review
+
+            set graphemes [punk::char::grapheme_split $o_graphemebuf$stringdata]
+            set outstring [join $graphemes ""]
+            #puts "outstring: '$outstring' graphemes: $graphemes"
+            if {$o_mode ne "none"} {
+                set outstring [::tcl::unsupported::icu::normalize -mode $o_mode $outstring]
+            }
+            set o_graphemebuf ""
+            return [tcl::encoding::convertto $o_enc $outstring]
+        }
+        method write {transform_handle bytes} {
+            set inputbytes $o_encbuf$bytes
+            set o_encbuf ""
+            set tail_offset 0
+
+            if {$inputbytes eq ""} {
+                #review - do we even get empty writes?
+                puts stderr "WARNING: write called on unicode_normalize with empty inputbytes. This may be a no-op, but it may also indicate an issue with the upstream transform or channel. Emitting no data for this write."
+                set stringdata ""
+            }
+
+            while {$tail_offset < [::tcl::string::length $inputbytes] && [catch {tcl::encoding::convertfrom $o_enc [::tcl::string::range $inputbytes 0 end-$tail_offset]} stringdata]} {
+                incr tail_offset
+            }
+            if {$tail_offset > 0} {
+                if {$tail_offset < [::tcl::string::length $inputbytes]} {
+                    #stringdata from catch statement must be a valid result
+                    set t [expr {$tail_offset - 1}]
+                    set o_encbuf [::tcl::string::range $inputbytes end-$t end]
+                } else {
+                    set stringdata ""
+                    set o_encbuf $inputbytes
+                    return ""
+                }
+            }
+            set graphemes [punk::char::grapheme_split $o_graphemebuf$stringdata]
+            set outstring [join [lrange $graphemes 0 end-1] ""]
+            set o_graphemebuf [lindex $graphemes end]
+
+            if {$o_mode ne "none"} {
+                set outstring [::tcl::unsupported::icu::normalize -mode $o_mode $outstring]
+            }
+
+            return [tcl::encoding::convertto $o_enc $outstring]
+        }
+        method meta_is_redirection {} {
+            return $o_is_junction
+        }
+    }
+
+
     #a test
     oo::class create reconvert {
         variable o_trecord
@@ -1114,7 +1272,6 @@ namespace eval shellfilter::chan {
         #    return $emit
         #}
         method flush {transform_handle} {
-            #return ""
             set clear $o_buffered$o_encbuf
             if {[catch {tcl::encoding::convertfrom $o_enc $clear} stringdata]} {
                 #if we can't convert the buffer contents to a string - does it make sense to emit the raw bytes?

src/modules/test/#modpod-overtype-999999.0a1.0/overtype-999999.0a1.0.tm

@@ -22,6 +22,7 @@ tcl::namespace::eval test::overtype {
     set version 999999.0a1.0
 
     package require packagetest
+    puts "test::overtype - packagetest version: [package provide packagetest]"
     packagetest::makeAPI test::overtype $version overtype; #will package provide test::overtype $version
     package forget overtype
     package require overtype

src/modules/test/runtestmodules.tcl

@@ -14,53 +14,96 @@ if {$modules_posn < 0} {
 }
 set modules_base [string range $script_dir 0 $modules_posn-1]
 if {[file tail $modules_base] eq "src"} {
+    set test_type "unbuilt"
     set project_root [file dirname $modules_base]
 } else {
+    set test_type "installed"
     set project_root $modules_base
 }
+
 puts stderr "runtestmodules.tcl project_root: $project_root"
-#use the unbuilt modules/libraries under development rather than the installed versions.
-#The unbuilt modules should have a higher version number (such as the magic version number 999999.0a1.0) than any installed versions to ensure they are preferred.
-tcl::tm::add    [file normalize $project_root/src/modules]
-tcl::tm::add    [file normalize $project_root/src/modules_tcl$tcl_major]
-tcl::tm::add    [file normalize $project_root/src/vendormodules]
-tcl::tm::add    [file normalize $project_root/src/vendormodules_tcl$tcl_major]
 
-# add 'package ifneeded' definitions for unbuilt #modpod modules.
+
-#first gather subdirectories of modules that contain #modpod-*-999999.0a1.0 in their name - these should be the unbuilt versions of zip based modules.
+#review - punk::path may itself be a module under test.
-#set subfolders [punk::path::subfolders -recursive [file normalize $project_root/src/modules] -match */#modpod-*-999999.0a1.0] 
+#we should ideally be independent of the modules under test.
-#'punk::path::subfolders' currently only supports negative matching with -exclude, so we have to filter for the positive match ourselves.
+#same goes for punk and punk::args.
-set subfolders [punk::path::subfolders -recursive [file normalize $project_root/src/modules] -exclude {**/_build/** **/_build}]
+package require punk::path
-foreach sub $subfolders {
+
-    #In most cases we could use string match - but the * within modpod-*-999999.0a1.0 could match a forward slash which could then match some other file under a #modpod- folder structure,
+
-    #so we use globmatchpath which treats * as matching any characters except path separators.
+if {$test_type eq "unbuilt"} {
-    if {[globmatchpath "**/#modpod-*-999999.0a1.0" $sub]} {
+    #use the unbuilt modules/libraries under development rather than the installed versions.
-        set modname [file tail $sub]
+    #The unbuilt modules should have a higher version number (such as the magic version number 999999.0a1.0) than any installed versions to ensure they are preferred.
-        set modname [string range $modname 8 end-12] ;#strip off #modpod- and -999999.0a1.0
+    tcl::tm::add    [file normalize $project_root/src/modules]
-        set modpath [file join $sub "$modname-999999.0a1.0.tm"]
+    tcl::tm::add    [file normalize $project_root/src/modules_tcl$tcl_major]
-        #!!!!
+    tcl::tm::add    [file normalize $project_root/src/vendormodules]
-        #todo - calculate fully qualified module name based on path relative to the modules folder we added to the tcl::tm path.
+    tcl::tm::add    [file normalize $project_root/src/vendormodules_tcl$tcl_major]
-        if {[file exists $modpath]} {
+        #when running against unbuilt modules - we want to ensure that the unbuilt versions of any modules are used rather than any installed versions - so we add package ifneeded definitions for the unbuilt versions of any modules that are present.
-            puts stderr "runtestmodules.tcl adding package ifneeded for modpod module $modname at path $modpath"
+    # add 'package ifneeded' definitions for unbuilt #modpod modules.
-            package ifneeded $modname 999999.0a1.0 [list source $modpath]
+    #first gather subdirectories of modules that contain #modpod-*-999999.0a1.0 in their name - these should be the unbuilt versions of zip based modules.
-        } else {
+    #set subfolders [punk::path::subfolders -recursive [file normalize $project_root/src/modules] -match */#modpod-*-999999.0a1.0]
-            puts stderr "runtestmodules.tcl warning: expected mod.tcl not found for modpod module $modname at path $modpath"
+    #'punk::path::subfolders' currently only supports negative matching with -exclude, so we have to filter for the positive match ourselves.
+    set subfolders [punk::path::subfolders -recursive  -exclude {**/_build/** **/_build} [file normalize $project_root/src/modules]]
+    foreach sub $subfolders {
+        #In most cases we could use string match - but the * within modpod-*-999999.0a1.0 could match a forward slash which could then match some other file under a #modpod- folder structure,
+        #so we use globmatchpath which treats * as matching any characters except path separators.
+        if {[punk::path::globmatchpath "**/#modpod-*-999999.0a1.0" $sub]} {
+            set modname [file tail $sub]
+            set modname [string range $modname 8 end-13] ;#strip off #modpod- and -999999.0a1.0
+            set modpath [file join $sub "$modname-999999.0a1.0.tm"]
+            #calculate fully qualified module name based on path relative to the modules folder we added to the tcl::tm path.
+            set relpath [punk::path::relative $project_root/src/modules [file dirname $sub]]
+            if {$relpath eq "."} {
+                set relpath ""
+                set fullmodname $modname
+            } else {
+                set components [file split $relpath]
+                set fullmodname [join $components ::]::$modname
+            }
+             #!!!!
+             #todo - review whether we also need to add the path to the module's folder to the auto_path to ensure that any 'package require' calls within the module will find the unbuilt version of any dependencies.
+             #we probably do need to do this - otherwise if there is an installed version of a dependency it could be loaded instead of the unbuilt version which is likely not what we want when running tests against unbuilt modules.
+
+            if {[file exists $modpath]} {
+                puts stderr "runtestmodules.tcl adding package ifneeded for modpod module $fullmodname at path $modpath"
+                package ifneeded $modname 999999.0a1.0 [list source $modpath]
+            } else {
+                puts stderr "runtestmodules.tcl warning: expected mod.tcl not found for modpod module $fullmodname at path $modpath"
+            }
+        }
+    }
+    #exit 1
+
+    set libdir      [file normalize $project_root/src/lib]
+    set libvdir     [file normalize $project_root/src/lib/tcl$tcl_major]
+    set libvldir      [file normalize $project_root/src/vendorlib]
+    set libvlvdir      [file normalize $project_root/src/vendorlib_tcl$tcl_major]
+    foreach d [list $libdir $libvdir $libvldir $libvlvdir] {
+        if {$d ni $::auto_path} {
+            lappend ::auto_path $d
         }
     }
-}
+    #------------------------------------
+    puts stderr "runtestmodules.tcl ::auto_path: $::auto_path"
+    puts stderr "runtestmodules.tcl tcl::tm::list: [tcl::tm::list]"
+} else {
+    tcl::tm::add    [file normalize $project_root/modules]
+    tcl::tm::add    [file normalize $project_root/modules_tcl$tcl_major]
+    tcl::tm::add    [file normalize $project_root/vendormodules]
+    tcl::tm::add    [file normalize $project_root/vendormodules_tcl$tcl_major]
 
-set libdir      [file normalize $project_root/src/lib]
+    set libdir      [file normalize $project_root/lib]
-set libvdir     [file normalize $project_root/src/lib/tcl$tcl_major]
+    set libvdir     [file normalize $project_root/lib/tcl$tcl_major]
-set libvldir      [file normalize $project_root/src/vendorlib]
+    set libvldir      [file normalize $project_root/vendorlib]
-set libvlvdir      [file normalize $project_root/src/vendorlib_tcl$tcl_major]
+    set libvlvdir      [file normalize $project_root/vendorlib_tcl$tcl_major]
-foreach d [list $libdir $libvdir $libvldir $libvlvdir] {
+    foreach d [list $libdir $libvdir $libvldir $libvlvdir] {
-    if {$d ni $::auto_path} {
+        if {$d ni $::auto_path} {
-        lappend ::auto_path $d
+            lappend ::auto_path $d
+        }
     }
+    #------------------------------------
+    puts stderr "runtestmodules.tcl ::auto_path: $::auto_path"
+    puts stderr "runtestmodules.tcl tcl::tm::list: [tcl::tm::list]"
 }
-#------------------------------------
-puts stderr "runtestmodules.tcl ::auto_path: $::auto_path"
-puts stderr "runtestmodules.tcl tcl::tm::list: [tcl::tm::list]"
 
 
 package require punk

src/tests/all.tcl

@@ -1,66 +0,0 @@
-#!tclsh
-#This script uses shellfilter::run calls under the hood
-lassign [split [info tclversion] .] tcl_major tcl_minor
-
-set script_dir [file dirname [info script]]
-
-#------------------------------------
-#use the unbuilt modules/libraries under development rather than the installed versions.
-set original_tmlist [tcl::tm::list]
-tcl::tm::remove {*}$original_tmlist
-tcl::tm::add [file normalize $script_dir/../modules] ;#ie <projectroot>/src/modules
-tcl::tm::add [file normalize $script_dir/../modules_tcl$tcl_major]
-tcl::tm::add {*}[lreverse $original_tmlist]
-set libdir  [file normalize $script_dir/../lib]
-set libvdir [file normalize $script_dir/../lib/tcl$tcl_major]
-if {$libdir ni $::auto_path} {
-    lappend ::auto_path $libdir
-}
-if {$libvdir ni $::auto_path} {
-    lappend ::auto_path $libvdir
-}
-#------------------------------------
-package require tcltest
-
-
-package require punk
-package require punk::args
-punk::args::define {
-    @id     -id (script)::runtestmodules
-    @cmd    -name runtestmodules -help\
-    "Run test:: modules that support the packagetest api
-    (have RUN command)"
-    -tcltestoptions -type dict -default "" -help\
-        "pairs of flags/values that will be passed to tcltest::configure before running the tests.
-        For example, to run only tests with names matching *foo* and *bar* you could use:
-         -tcltestoptions {-file {*foo* *bar*}} 
-        "
-    @values -min 0 -max -1
-    glob -type string -multiple 1 -optional 1 -help\
-    " names or glob patterns of test files to run."
-}
-set argd [punk::args::parse $::argv withid (script)::runtestmodules]
-lassign [dict values $argd] leaders opts values received
-set tcltestoptions  [dict get $opts -tcltestoptions]
-if {![dict exists $received glob]} {
-    set file_globs [list *.test]
-} else {
-    set file_globs [dict get $values glob]
-}
-
-set ::argv $tcltestoptions
-set ::argc [llength $tcltestoptions]
-#set ::argv {}
-#set ::argc 0
-
-tcltest::configure -verbose "body pass skip error usec"
-tcltest::configure -testdir $script_dir
-tcltest::configure -file $file_globs
-#review - single process has less isolation - but works better in this case.
-#(some tclsh shells can hang when running with -singleproc false - needs investigation)
-#tclte::configure -singleproc true
-tcltest::configure -singleproc true
-dict for {k v} $tcltestoptions {
-    tcltest::configure $k $v
-}
-tcltest::runAllTests

src/tests/modules/punk/path/tests/path.test

@@ -1,33 +0,0 @@
-package require tcltest
-tcltest::configure {*}$::argv
-
-
-package require overtype
-package require punk::path
-
-namespace eval ::testspace {
-    namespace import ::tcltest::*
-    variable common {
-        set result ""
-    }
-
-
-    test globmatchpath_basic {Test single star between slashes pathglob argument will match exactly a single level}\
-        -setup $common -body {
-
-            set result [list                                                    {*}{
-                }  [punk::path::globmatchpath /etc/*/*.doc /etc/A/test.doc]     {*}{
-                }  [punk::path::globmatchpath /etc/*/*.doc /etc/A/B/test.doc]   {*}{
-                }  [punk::path::globmatchpath /etc/*/*.doc /etc/test.doc]
-            ]
-
-        }\
-        -cleanup {
-        }\
-        -result [list {*}{
-            1 0 0 
-        }]
-
-}
-
-tcltest::cleanupTests ;#needed to produce test summary.

src/tests/modules/punk/path/testsuites/tests/all.tcl

@@ -19,6 +19,11 @@ set project_root [string range $script_dir 0 $src_tests_posn-1]
 #The unbuilt modules should have a higher version number (such as the magic version number 999999.0a1.0) than any installed versions to ensure they are preferred.
 tcl::tm::add [file normalize $project_root/src/modules]
 tcl::tm::add [file normalize $project_root/src/modules_tcl$tcl_major]
+
+#temp
+puts "punk::path version: [package require punk::path]"
+puts "Module search path: [tcl::tm::list]"
+
 set libdir  [file normalize $project_root/src/lib]
 set libvdir [file normalize $project_root/src/lib/tcl$tcl_major]
 if {$libdir ni $::auto_path} {

src/tests/modules/punk/path/testsuites/tests/path.test

@@ -0,0 +1,410 @@
+package require tcltest
+tcltest::configure {*}$::argv
+
+
+package require punk::lib
+package require punk::path
+
+namespace eval ::testspace {
+    namespace import ::tcltest::*
+
+    variable common {
+        set result ""
+    }
+
+    variable subfolders_tree {
+        set sub_prevdir [pwd]
+        set sub_newbase [punk::lib::tempdir_newfolder -prefix punk_path_subfolders]
+        cd $sub_newbase
+        set sub_tree_tail __punk_path_subfolders_test__
+        set sub_tree_root [file join $sub_newbase $sub_tree_tail]
+        file mkdir [file join $sub_tree_root keep]
+        file mkdir [file join $sub_tree_root src vfs deep]
+        file mkdir [file join $sub_tree_root aside child grandchild]
+    }
+
+    variable subfolders_cleanup {
+        cd $sub_prevdir
+        file delete -force $sub_newbase
+    }
+
+    variable repeated_subfolders_tree {
+        set rep_prevdir [pwd]
+        set rep_newbase [punk::lib::tempdir_newfolder  -prefix punk_path_repeated_subfolders]
+        cd $rep_newbase
+        set rep_tree_tail __punk_path_repeated_subfolders_test__
+        set rep_tree_root [file join $rep_newbase $rep_tree_tail]
+        file mkdir [file join $rep_tree_root alpha a a leaf deeper]
+        file mkdir [file join $rep_tree_root alpha a x a leaf deeper]
+        file mkdir [file join $rep_tree_root alpha a xx a leaf deeper]
+        file mkdir [file join $rep_tree_root alpha a x y a leaf deeper]
+        file mkdir [file join $rep_tree_root alpha a x y z a leaf deeper]
+        file mkdir [file join $rep_tree_root alpha a x y z keep]
+        file mkdir [file join $rep_tree_root alpha a q aa leaf deeper]
+        file mkdir [file join $rep_tree_root alpha aa x a leaf deeper]
+    }
+
+    variable repeated_subfolders_cleanup {
+        cd $rep_prevdir
+        file delete -force $rep_newbase
+    }
+
+    variable treefilenames_tree {
+        set tf_prevdir [pwd]
+        set tf_newbase [punk::lib::tempdir_newfolder  -prefix punk_path_treefilenames]
+        cd $tf_newbase
+        set tf_tree_tail __punk_path_treefilenames_test__
+        set tf_tree_root [file join $tf_newbase $tf_tree_tail]
+        file mkdir [file join $tf_tree_root keep]
+        file mkdir [file join $tf_tree_root src vfs deep]
+        file mkdir [file join $tf_tree_root aside child grandchild]
+        foreach relpath {
+            keep/keep.txt
+            src/srcroot.txt
+            src/vfs/vfs.txt
+            src/vfs/deep/deep.txt
+            aside/aside.txt
+            aside/child/child.txt
+            aside/child/grandchild/grandchild.txt
+            b/other/other.txt
+        } {
+            set filepath [file join $tf_tree_root $relpath]
+            file mkdir [file dirname $filepath]
+            set channel [open $filepath w]
+            puts $channel $relpath
+            close $channel
+        }
+    }
+
+    variable treefilenames_cleanup {
+        cd $tf_prevdir
+        file delete -force $tf_newbase
+    }
+
+    test globmatchpath_basic {Test single star between slashes pathglob argument will match exactly a single level} \
+        -setup $common -body {
+            set result [list \
+                [punk::path::globmatchpath /etc/*/*.doc /etc/A/test.doc] \
+                [punk::path::globmatchpath /etc/*/*.doc /etc/A/B/test.doc] \
+                [punk::path::globmatchpath /etc/*/*.doc /etc/test.doc] \
+            ]
+        } \
+        -cleanup {
+        } \
+        -result {1 0 0}
+
+    test subfolders_exclude_trailing_doublestar {Trailing /** prunes descendants but keeps the matching base directory} \
+        -setup $subfolders_tree -body {
+            set result [lsort [punk::path::subfolders -recursive -exclude-paths {**/src/**} .]]
+            set expected [lsort [list \
+                [file join . $sub_tree_tail] \
+                [file join . $sub_tree_tail aside] \
+                [file join . $sub_tree_tail aside child] \
+                [file join . $sub_tree_tail aside child grandchild] \
+                [file join . $sub_tree_tail keep] \
+                [file join . $sub_tree_tail src] \
+            ]]
+            expr {$result eq $expected}
+        } \
+        -cleanup $subfolders_cleanup \
+        -result 1
+
+    test subfolders_exclude_single_segment {Single-level excludes omit the node but still recurse into it} \
+        -setup $subfolders_tree -body {
+            set result [lsort [punk::path::subfolders -recursive -exclude-paths {**/aside/*} .]]
+            set expected [lsort [list \
+                [file join . $sub_tree_tail] \
+                [file join . $sub_tree_tail aside] \
+                [file join . $sub_tree_tail aside child grandchild] \
+                [file join . $sub_tree_tail keep] \
+                [file join . $sub_tree_tail src] \
+                [file join . $sub_tree_tail src vfs] \
+                [file join . $sub_tree_tail src vfs deep] \
+            ]]
+            expr {$result eq $expected}
+        } \
+        -cleanup $subfolders_cleanup \
+        -result 1
+
+    test subfolders_exclude_exact_segment {Exact segment excludes omit the node but still traverse below it} \
+        -setup $subfolders_tree -body {
+            set result [lsort [punk::path::subfolders -recursive -exclude-paths {**/aside} .]]
+            set expected [lsort [list \
+                [file join . $sub_tree_tail] \
+                [file join . $sub_tree_tail aside child] \
+                [file join . $sub_tree_tail aside child grandchild] \
+                [file join . $sub_tree_tail keep] \
+                [file join . $sub_tree_tail src] \
+                [file join . $sub_tree_tail src vfs] \
+                [file join . $sub_tree_tail src vfs deep] \
+            ]]
+            expr {$result eq $expected}
+        } \
+        -cleanup $subfolders_cleanup \
+        -result 1
+
+    test subfolders_exclude_combined_patterns {Subtree and exact excludes compose correctly in recursive traversal} \
+        -setup $subfolders_tree -body {
+            set result [lsort [punk::path::subfolders -recursive -exclude-paths {**/src/** **/aside} .]]
+            set expected [lsort [list \
+                [file join . $sub_tree_tail] \
+                [file join . $sub_tree_tail aside child] \
+                [file join . $sub_tree_tail aside child grandchild] \
+                [file join . $sub_tree_tail keep] \
+                [file join . $sub_tree_tail src] \
+            ]]
+            expr {$result eq $expected}
+        } \
+        -cleanup $subfolders_cleanup \
+        -result 1
+
+    test subfolders_repeated_segments_single_star {Repeated segment exclude with one wildcard segment prunes only that shape} \
+        -setup $repeated_subfolders_tree -body {
+            set result [punk::path::subfolders -recursive -exclude-paths {**/a/*/a/**} .]
+            expr { \
+                [file join . $rep_tree_tail alpha a x a] in $result \
+                && [file join . $rep_tree_tail alpha a x a leaf] ni $result \
+                && [file join . $rep_tree_tail alpha a x a leaf deeper] ni $result \
+                && [file join . $rep_tree_tail alpha a x y a leaf] in $result \
+                && [file join . $rep_tree_tail alpha a x y z keep] in $result \
+            }
+        } \
+        -cleanup $repeated_subfolders_cleanup \
+        -result 1
+
+    test subfolders_repeated_segments_two_single_stars {Repeated segment exclude with two wildcard segments prunes only that shape} \
+        -setup $repeated_subfolders_tree -body {
+            set result [punk::path::subfolders -recursive -exclude-paths {**/a/*/*/a/**} .]
+            expr { \
+                [file join . $rep_tree_tail alpha a x y a] in $result \
+                && [file join . $rep_tree_tail alpha a x y a leaf] ni $result \
+                && [file join . $rep_tree_tail alpha a x y a leaf deeper] ni $result \
+                && [file join . $rep_tree_tail alpha a x a leaf] in $result \
+                && [file join . $rep_tree_tail alpha a x y z a leaf] in $result \
+            }
+        } \
+        -cleanup $repeated_subfolders_cleanup \
+        -result 1
+
+    test subfolders_repeated_segments_middle_doublestar {Repeated segment exclude with middle doublestar prunes repeated a descendants at multiple depths} \
+        -setup $repeated_subfolders_tree -body {
+            set result [punk::path::subfolders -recursive -exclude-paths {**/a/**/a/**} .]
+            expr { \
+                [file join . $rep_tree_tail alpha a x a] in $result \
+                && [file join . $rep_tree_tail alpha a x y a] in $result \
+                && [file join . $rep_tree_tail alpha a x y z a] in $result \
+                && [file join . $rep_tree_tail alpha a x a leaf] ni $result \
+                && [file join . $rep_tree_tail alpha a x y a leaf] ni $result \
+                && [file join . $rep_tree_tail alpha a x y z a leaf] ni $result \
+            }
+        } \
+        -cleanup $repeated_subfolders_cleanup \
+        -result 1
+
+    test subfolders_repeated_segments_nonmatching_pattern {Repeated path segments are retained when pattern literals do not match} \
+        -setup $repeated_subfolders_tree -body {
+            set result [punk::path::subfolders -recursive -exclude-paths {**/a/*/b/**} .]
+            expr { \
+                [file join . $rep_tree_tail alpha a x a leaf] in $result \
+                && [file join . $rep_tree_tail alpha a x y a leaf] in $result \
+                && [file join . $rep_tree_tail alpha a x y z a leaf] in $result \
+            }
+        } \
+        -cleanup $repeated_subfolders_cleanup \
+        -result 1
+
+    test subfolders_repeated_segments_exact_boundary {Exact repeated segment excludes boundary node but still traverses below it} \
+        -setup $repeated_subfolders_tree -body {
+            set result [punk::path::subfolders -recursive -exclude-paths {**/a/*/a} .]
+            expr { \
+                [file join . $rep_tree_tail alpha a x a] ni $result \
+                && [file join . $rep_tree_tail alpha a x a leaf] in $result \
+                && [file join . $rep_tree_tail alpha a x y a] in $result \
+            }
+        } \
+        -cleanup $repeated_subfolders_cleanup \
+        -result 1
+
+    test subfolders_repeated_segments_adjacent_literals {Adjacent repeated literals match only adjacent path segments} \
+        -setup $repeated_subfolders_tree -body {
+            set result [punk::path::subfolders -recursive -exclude-paths {**/a/a/**} .]
+            expr { \
+                [file join . $rep_tree_tail alpha a a] in $result \
+                && [file join . $rep_tree_tail alpha a a leaf] ni $result \
+                && [file join . $rep_tree_tail alpha a x a leaf] in $result \
+            }
+        } \
+        -cleanup $repeated_subfolders_cleanup \
+        -result 1
+
+    test subfolders_repeated_segments_question_segment {Question mark wildcard matches exactly one character within one segment} \
+        -setup $repeated_subfolders_tree -body {
+            set result [punk::path::subfolders -recursive -exclude-paths {**/a/?/a/**} .]
+            expr { \
+                [file join . $rep_tree_tail alpha a x a] in $result \
+                && [file join . $rep_tree_tail alpha a x a leaf] ni $result \
+                && [file join . $rep_tree_tail alpha a xx a leaf] in $result \
+            }
+        } \
+        -cleanup $repeated_subfolders_cleanup \
+        -result 1
+
+    test subfolders_repeated_segments_similar_names {Similar segment names do not match repeated literal a patterns accidentally} \
+        -setup $repeated_subfolders_tree -body {
+            set result [punk::path::subfolders -recursive -exclude-paths {**/a/*/a/**} .]
+            expr { \
+                [file join . $rep_tree_tail alpha a q aa leaf] in $result \
+                && [file join . $rep_tree_tail alpha aa x a leaf] in $result \
+            }
+        } \
+        -cleanup $repeated_subfolders_cleanup \
+        -result 1
+
+    test subfolders_repeated_segments_similar_name_patterns {Similar literal aa patterns match only their own segment shapes} \
+        -setup $repeated_subfolders_tree -body {
+            set result [punk::path::subfolders -recursive -exclude-paths {**/a/*/aa/** **/aa/*/a/**} .]
+            expr { \
+                [file join . $rep_tree_tail alpha a q aa] in $result \
+                && [file join . $rep_tree_tail alpha a q aa leaf] ni $result \
+                && [file join . $rep_tree_tail alpha aa x a] in $result \
+                && [file join . $rep_tree_tail alpha aa x a leaf] ni $result \
+                && [file join . $rep_tree_tail alpha a x a leaf] in $result \
+            }
+        } \
+        -cleanup $repeated_subfolders_cleanup \
+        -result 1
+
+    test subfolders_repeated_segments_overlapping_patterns {Overlapping repeated segment excludes prune each matching shape independently} \
+        -setup $repeated_subfolders_tree -body {
+            set result [punk::path::subfolders -recursive -exclude-paths {**/a/*/a/** **/a/*/*/a/**} .]
+            expr { \
+                [file join . $rep_tree_tail alpha a x a leaf] ni $result \
+                && [file join . $rep_tree_tail alpha a x y a leaf] ni $result \
+                && [file join . $rep_tree_tail alpha a x y z a leaf] in $result \
+                && [file join . $rep_tree_tail alpha a x y z keep] in $result \
+            }
+        } \
+        -cleanup $repeated_subfolders_cleanup \
+        -result 1
+
+    test treefilenames_recurse_nested_positive_glob {Positive glob traversal reaches nested matches below unmatched ancestors} \
+        -setup $treefilenames_tree -body {
+            set result [lsort [punk::path::treefilenames -sort none -directory . -include-paths {**/src/**} *.txt]]
+            set expected [lsort [list \
+                [file join . $tf_tree_tail src vfs deep deep.txt] \
+                [file join . $tf_tree_tail src vfs vfs.txt] \
+            ]]
+            expr {$result eq $expected}
+        } \
+        -cleanup $treefilenames_cleanup \
+        -result 1
+
+    test treefilenames_nonexistent_glob_path_returns_empty {Non-matching glob_paths subtree should return no files} \
+        -setup $treefilenames_tree -body {
+            set result [punk::path::treefilenames -sort none -directory . -include-paths {**/nonexistantfolder/**} *]
+            expr {$result eq [list]}
+        } \
+        -cleanup $treefilenames_cleanup \
+        -result 1
+
+    test treefilenames_tailbase_newbase_returns_tree_tail {Tailbase can trim returned filenames to the tree folder} \
+        -setup $treefilenames_tree -body {
+            set result [lsort [punk::path::treefilenames -sort none -directory $tf_tree_root -tailbase $tf_newbase *.txt]]
+            set expected [lsort [list \
+                [file join $tf_tree_tail aside aside.txt] \
+                [file join $tf_tree_tail aside child child.txt] \
+                [file join $tf_tree_tail aside child grandchild grandchild.txt] \
+                [file join $tf_tree_tail b other other.txt] \
+                [file join $tf_tree_tail keep keep.txt] \
+                [file join $tf_tree_tail src srcroot.txt] \
+                [file join $tf_tree_tail src vfs deep deep.txt] \
+                [file join $tf_tree_tail src vfs vfs.txt] \
+            ]]
+            expr {$result eq $expected}
+        } \
+        -cleanup $treefilenames_cleanup \
+        -result 1
+
+    test treefilenames_tailbase_tree_root_returns_tree_relative {Tailbase can trim returned filenames to paths below the search root} \
+        -setup $treefilenames_tree -body {
+            set result [lsort [punk::path::treefilenames -sort none -directory $tf_tree_root -tailbase $tf_tree_root *.txt]]
+            set expected [lsort [list \
+                [file join aside aside.txt] \
+                [file join aside child child.txt] \
+                [file join aside child grandchild grandchild.txt] \
+                [file join b other other.txt] \
+                [file join keep keep.txt] \
+                [file join src srcroot.txt] \
+                [file join src vfs deep deep.txt] \
+                [file join src vfs vfs.txt] \
+            ]]
+            expr {$result eq $expected}
+        } \
+        -cleanup $treefilenames_cleanup \
+        -result 1
+
+    test treefilenames_tailbase_exclude_paths_match_returned_paths {Exclude paths match tailbase-relative returned paths} \
+        -setup $treefilenames_tree -body {
+            set result [lsort [punk::path::treefilenames -sort none -directory $tf_tree_root -tailbase $tf_tree_root -exclude-paths {aside aside/** src/vfs/**} *.txt]]
+            set expected [lsort [list \
+                [file join b other other.txt] \
+                [file join keep keep.txt] \
+                [file join src srcroot.txt] \
+                [file join src vfs vfs.txt] \
+            ]]
+            expr {$result eq $expected}
+        } \
+        -cleanup $treefilenames_cleanup \
+        -result 1
+
+    test treefilenames_tailbase_include_paths_match_tree_root_relative_paths {Include paths match tailbase-relative paths below the tree root} \
+        -setup $treefilenames_tree -body {
+            set result [lsort [punk::path::treefilenames -sort none -directory $tf_tree_root -tailbase $tf_tree_root -include-paths {src/**} *.txt]]
+            set expected [lsort [list \
+                [file join src vfs deep deep.txt] \
+                [file join src vfs vfs.txt] \
+            ]]
+            expr {$result eq $expected}
+        } \
+        -cleanup $treefilenames_cleanup \
+        -result 1
+
+    test treefilenames_tailbase_include_paths_match_newbase_relative_paths {Include paths include the tree folder when tailbase is above the search root} \
+        -setup $treefilenames_tree -body {
+            set include_path [file join $tf_tree_tail src **]
+            set result [lsort [punk::path::treefilenames -sort none -directory $tf_tree_root -tailbase $tf_newbase -include-paths [list $include_path] *.txt]]
+            set expected [lsort [list \
+                [file join $tf_tree_tail src vfs deep deep.txt] \
+                [file join $tf_tree_tail src vfs vfs.txt] \
+            ]]
+            expr {$result eq $expected}
+        } \
+        -cleanup $treefilenames_cleanup \
+        -result 1
+
+    test treefilenames_tailbase_include_and_exclude_paths_share_relative_base {Include and exclude paths use the same tailbase-relative base} \
+        -setup $treefilenames_tree -body {
+            set result [lsort [punk::path::treefilenames -sort none -directory $tf_tree_root -tailbase $tf_tree_root -include-paths {src/**} -exclude-paths {src/vfs/**} *.txt]]
+            set expected [list [file join src vfs vfs.txt]]
+            expr {$result eq $expected}
+        } \
+        -cleanup $treefilenames_cleanup \
+        -result 1
+
+    test treefilenames_rejects_internal_call_flags {Internal recursion state flags are not public API} \
+        -setup $treefilenames_tree -body {
+            set results [list]
+            foreach arglist {
+                {-call-depth-internal 1 -directory . *}
+                {-call-subvector {a b} -directory . *}
+                {-call-allbelow 1 -directory . *}
+            } {
+                lappend results [catch {punk::path::treefilenames {*}$arglist}]
+            }
+            expr {$results eq {1 1 1}}
+        } \
+        -cleanup $treefilenames_cleanup \
+        -result 1
+}
+
+tcltest::cleanupTests ;#needed to produce test summary.

src/tests/runtests.tcl

@@ -0,0 +1,125 @@
+#!tclsh
+#This script uses shellfilter::run calls under the hood
+lassign [split [info tclversion] .] tcl_major tcl_minor
+set test_base [file dirname [file normalize [info script]]]
+set test_base_parent [file dirname $test_base]
+if {[file tail $test_base_parent] eq "src"} {
+    set project_root [file dirname $test_base_parent]
+} else {
+    set msg "Error: test script is not under a src/ directory: $test_base"
+    append msg \n "To run tests against the built modules, run src/make.tcl packages and then see the modules/test folder within this project"
+    puts stderr $msg
+    exit 2
+}
+
+#------------------------------------
+#For the toplevel script, use the bootsupport modules.
+set original_tmlist [tcl::tm::list]
+tcl::tm::remove {*}$original_tmlist
+tcl::tm::add [file normalize $project_root/src/bootsupport/modules] ;#ie <projectroot>/src/modules
+tcl::tm::add [file normalize $project_root/src/bootsupport/modules_tcl$tcl_major]
+tcl::tm::add {*}[lreverse $original_tmlist]
+set libdir [list]
+set libdir [file normalize $project_root/src/bootsupport/lib]
+set libvdir [file normalize $project_root/src/bootsupport/lib/tcl$tcl_major]
+if {$libdir ni $::auto_path} {
+    lappend ::auto_path $libdir
+}
+if {$libvdir ni $::auto_path} {
+    lappend ::auto_path $libvdir
+}
+#------------------------------------
+
+#------------------------------------
+#for the tests running in child processes,
+#use the unbuilt modules/libraries under development rather than the installed versions.
+set tmlist [list]
+lappend tmlist [file normalize $test_base/../modules] ;#ie <projectroot>/src/modules
+lappend tmlist [file normalize $test_base/../modules_tcl$tcl_major]
+set libdirs [list]
+lappend libdirs [file normalize $test_base/../lib]
+lappend libdirs [file normalize $test_base/../lib/tcl$tcl_major]
+if {$libdir ni $::auto_path} {
+    lappend ::auto_path $libdir
+}
+if {$libvdir ni $::auto_path} {
+    lappend ::auto_path $libvdir
+}
+#------------------------------------
+
+
+package require punk
+package require punk::args
+punk::args::define {
+    @id     -id (script)::runtestmodules
+    @cmd    -name runtestmodules -help\
+    "Run test:: modules that support the packagetest api
+    (have RUN command)"
+    -tcltestoptions -type dict -default "" -help\
+        "pairs of flags/values that will be passed to tcltest::configure before running the tests.
+        For example, to run tests with verbose settings:
+         -tcltestoptions {-verbose {body pass skip error usec}}
+        "
+    -include-paths -type list -default {**} -help\
+        "list of glob patterns for paths.
+        Only test files under paths matching these patterns will be included.
+        For example, to only include test files under src/modules/test:
+         -include-paths {src/modules/test/**}"
+    @values -min 0 -max -1
+    glob -type string -multiple 1 -optional 1 -help\
+    " names or glob patterns of test files to run.
+    This matches against the file tail - so should not include path segments.
+    The default if not supplied is a single *.test entry.
+    "
+}
+
+
+puts "argv: $::argv"
+
+
+set argd [punk::args::parse $::argv withid (script)::runtestmodules]
+lassign [dict values $argd] leaders opts values received
+set tcltestoptions  [dict get $opts -tcltestoptions]
+set include_paths   [dict get $opts -include-paths]
+if {![dict exists $received glob]} {
+    set file_globs [list *.test]
+} else {
+    set file_globs [dict get $values glob]
+}
+
+
+puts "tcltestoptions: $tcltestoptions"
+puts "file_globs: $file_globs"
+puts "test_base: $test_base"
+
+set thisexecutable [info nameofexecutable]
+puts "executable: $thisexecutable"
+
+set exclude_files [list AGENTS.md *.tcl]
+
+set testfiles [punk::path::treefilenames -dir $test_base -exclude-files $exclude_files -include-paths $include_paths $file_globs]
+foreach f $testfiles {
+    puts "test file: $f"
+}
+
+exit 1
+
+#don't package require tcltest too early or it may examine and respond to ::argv itself. (e.g to respond to --help, but we have our own help)
+package require tcltest
+
+set ::argv $tcltestoptions
+set ::argc [llength $tcltestoptions]
+#set ::argv {}
+#set ::argc 0
+
+tcltest::configure -verbose "body pass skip error usec"
+tcltest::configure -testdir $script_dir
+tcltest::configure -file $file_globs
+#review - single process has less isolation - but works better in this case.
+#(some tclsh shells can hang when running with -singleproc false - needs investigation)
+#tclte::configure -singleproc true
+tcltest::configure -singleproc true
+dict for {k v} $tcltestoptions {
+    tcltest::configure $k $v
+}
+tcltest::runAllTests