diff --git a/src/vfs/_vfscommon.vfs/modules/punkboot/utils-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punkboot/utils-0.2.0.tm similarity index 77% rename from src/vfs/_vfscommon.vfs/modules/punkboot/utils-0.1.1.tm rename to src/vfs/_vfscommon.vfs/modules/punkboot/utils-0.2.0.tm index be23f56e..736f28f8 100644 --- a/src/vfs/_vfscommon.vfs/modules/punkboot/utils-0.1.1.tm +++ b/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]]} { - dict set checkedroots fossil,$fossilroot 1 + if {$fossilroot ne "" && ![dict exists $checkedroots fossil,$fossilroot,$scope] && [llength [auto_execok fossil]]} { + 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 ""} { - 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" + } else { + set flines [list] + foreach line [split $fchanges \n] { + set line [string trim $line] + if {$line eq ""} {continue} + if {$scopeabs ne ""} { + #fossil changes lines are ' ' + 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]]} { - dict set checkedroots git,$gitroot 1 + if {$gitroot ne "" && ![dict exists $checkedroots git,$gitroot,$scope] && [llength [auto_execok git]]} { + 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