vfscommonupdate: sync punkboot::utils 0.2.0 into _vfscommon.vfs

make.tcl vfscommonupdate output: punkboot::utils 0.1.1 -> 0.2.0
(scoped vcs_dirty_warnings supporting the dirty-src provenance gate).

Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com

src/vfs/_vfscommon.vfs/modules/punkboot/utils-0.2.0.tm

@@ -7,7 +7,7 @@
 # (C) 2023
 #
 # @@ Meta Begin
-# Application punkboot::utils 0.1.1
+# Application punkboot::utils 0.2.0
 # Meta platform     tcl
 # Meta license      BSD
 # @@ Meta End
@@ -134,6 +134,10 @@ namespace eval punkboot::utils {
                     used to report each VCS root at most once across calls.
                     label, if supplied, is prefixed into each warning to name
                     the calling operation (e.g. 'vendorupdate').
+                    scope, if supplied, is a subpath relative to path; only
+                    uncommitted changes under that subpath are counted (e.g.
+                    scope 'src' warns about dirty src/ while ignoring dirt
+                    elsewhere in the checkout).
 
                     Returns an empty list if the path is clean, unversioned,
                     missing, already reported, or state cannot be determined."
@@ -144,9 +148,11 @@ namespace eval punkboot::utils {
                     "Name of a dict variable in the caller's scope for dedupe across calls"
                 label       -type string -optional 1 -default "" -help\
                     "Operation name prefixed into warnings"
+                scope       -type string -optional 1 -default "" -help\
+                    "Subpath relative to path limiting which changes count; empty = whole checkout"
         }]
     }
-    proc vcs_dirty_warnings {path checkedrootsvar {label ""}} {
+    proc vcs_dirty_warnings {path checkedrootsvar {label ""} {scope ""}} {
         upvar 1 $checkedrootsvar checkedroots
         if {![info exists checkedroots]} {set checkedroots [dict create]}
         if {$label ne ""} {set label "$label "}
@@ -155,6 +161,12 @@ namespace eval punkboot::utils {
         if {![file isdirectory $dir]} {
             return $warnings ;#missing path - not this proc's business to report
         }
+        set scopeabs ""
+        set scopedesc "" ;#included in warning text when scoped
+        if {$scope ne ""} {
+            set scopeabs [file normalize [file join $dir $scope]]
+            set scopedesc " under [string trimright $scope /]/"
+        }
         set fossilroot ""
         set gitroot ""
         while {1} {
@@ -171,8 +183,8 @@ namespace eval punkboot::utils {
             if {$parent eq $dir} { break }
             set dir $parent
         }
-        if {$fossilroot ne "" && ![dict exists $checkedroots fossil,$fossilroot] && [llength [auto_execok fossil]]} {
+        if {$fossilroot ne "" && ![dict exists $checkedroots fossil,$fossilroot,$scope] && [llength [auto_execok fossil]]} {
-            dict set checkedroots fossil,$fossilroot 1
+            dict set checkedroots fossil,$fossilroot,$scope 1
             #fossil changes must run from within the checkout
             set original_cwd [pwd]
             if {[catch {
@@ -180,19 +192,37 @@ namespace eval punkboot::utils {
                 set fchanges [string trim [exec {*}[auto_execok fossil] changes]]
             } errM]} {
                 lappend warnings "WARNING: ${label}could not determine fossil state of source project at $fossilroot ($errM)"
-            } elseif {$fchanges ne ""} {
+            } else {
-                lappend warnings "WARNING: ${label}source project at $fossilroot has uncommitted fossil changes ([llength [split $fchanges \n]] file(s)) - artifacts built from a dirty tree have no committed provenance"
+                set flines [list]
+                foreach line [split $fchanges \n] {
+                    set line [string trim $line]
+                    if {$line eq ""} {continue}
+                    if {$scopeabs ne ""} {
+                        #fossil changes lines are '<STATUS>  <path-relative-to-checkout-root>'
+                        if {![regexp {^\S+\s+(.*)$} $line _ relfile]} {continue}
+                        set normfile [file normalize [file join $fossilroot $relfile]]
+                        if {$normfile ne $scopeabs && ![string match "${scopeabs}/*" $normfile]} {continue}
+                    }
+                    lappend flines $line
+                }
+                if {[llength $flines]} {
+                    lappend warnings "WARNING: ${label}source project at $fossilroot has uncommitted fossil changes${scopedesc} ([llength $flines] file(s)) - artifacts built from a dirty tree have no committed provenance"
+                }
             }
             cd $original_cwd
         }
-        if {$gitroot ne "" && ![dict exists $checkedroots git,$gitroot] && [llength [auto_execok git]]} {
+        if {$gitroot ne "" && ![dict exists $checkedroots git,$gitroot,$scope] && [llength [auto_execok git]]} {
-            dict set checkedroots git,$gitroot 1
+            dict set checkedroots git,$gitroot,$scope 1
+            set gitpathargs [list]
+            if {$scopeabs ne ""} {
+                set gitpathargs [list -- $scopeabs]
+            }
             if {[catch {
-                set gchanges [string trim [exec {*}[auto_execok git] -C $gitroot status --porcelain]]
+                set gchanges [string trim [exec {*}[auto_execok git] -C $gitroot status --porcelain {*}$gitpathargs]]
             } errM]} {
                 lappend warnings "WARNING: ${label}could not determine git state of source project at $gitroot ($errM)"
             } elseif {$gchanges ne ""} {
-                lappend warnings "WARNING: ${label}source project at $gitroot has uncommitted git changes ([llength [split $gchanges \n]] file(s)) - artifacts built from a dirty tree have no committed provenance"
+                lappend warnings "WARNING: ${label}source project at $gitroot has uncommitted git changes${scopedesc} ([llength [split $gchanges \n]] file(s)) - artifacts built from a dirty tree have no committed provenance"
             }
         }
         return $warnings
@@ -207,8 +237,8 @@ namespace eval ::punk::args::register {
 ##  Ready
 package provide punkboot::utils [tcl::namespace::eval punkboot::utils {
     variable version
-    #- this version number, exactly 0.1.1, is a literal used in src module folders
+    #- this version number, exactly 0.2.0, is a literal used in src module folders
     #- we refer to this sometimes as the magic version number
-    set version 0.1.1
+    set version 0.2.0
 }]
 return