Browse Source
A source .vfs carrying an actual root main.tcl AND a root fauxlink resolving to main.tcl (or several such fauxlinks) baked whichever boot script merge traversal met last - merge_over's fauxlink branch overwrites without warning. New punkboot::utils::vfs_startup_script_report (0.7.0) censuses root startup-script suppliers by RESOLVED fauxlink name (empty-nominalname links included; nested app/main.tcl exempt per G-129). make.tcl consumes it with the same guarded-require degradation as the G-125/G-133/G-134 checks and refuses affected kits per-kit under FAILED KITS before any build product is written - kits from other folders proceed, deployed binaries untouched. Fixture characterization: startupscript.test (12 tests incl. a real-source-tree sweep proving today's folders are collision-free); bootlibrary.test re-run green. Outputs (mint 0.7.0 + bootsupport/vfscommon promotion) follow in a separate commit. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
6 changed files with 336 additions and 3 deletions
@ -0,0 +1,187 @@
|
||||
# -*- tcl -*- |
||||
# Tests for punkboot::utils::vfs_startup_script_report - the structural startup-script |
||||
# census behind make.tcl's G-031 startup-script collision gate: |
||||
# - the three clean shapes a kit SOURCE .vfs folder may have (actual root main.tcl, |
||||
# root fauxlink resolving to main.tcl, none at all - the last is legal and owned by |
||||
# the bake's separate missing-startup warning) |
||||
# - the collision verdict: more than one root-level supplier of the name main.tcl |
||||
# (actual file + fauxlink, or several fauxlinks) - the case merge_over materialises |
||||
# in traversal order with no overwrite warning from its fauxlink branch |
||||
# - resolved-NAME detection (an empty-nominalname link whose target tail is main.tcl |
||||
# collides; filename-prefix parsing would miss it), nested app/main.tcl exemption |
||||
# (G-129 undroidwish convention), unresolvable-link reporting, and the real source |
||||
# .vfs folders of this checkout (which must all be collision-free) |
||||
# Directory fixtures only - the check reads names, never opens targets, executes nothing. |
||||
# Run: tclsh src/tests/runtests.tcl -report compact -show-passes 0 -include-paths modules/punkboot/utils/*** startupscript.test |
||||
|
||||
package require tcltest |
||||
package require punkboot::utils |
||||
|
||||
#added 2026-08-02 (agent, G-031) |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
variable BASE [makeDirectory g031_startupscript] |
||||
|
||||
#<projectroot>/src/tests/modules/punkboot/utils/testsuites/utils -> 7 levels up |
||||
variable projectroot [file normalize [file join [file dirname [info script]] .. .. .. .. .. .. ..]] |
||||
variable srcvfsfolder [file join $projectroot src vfs] |
||||
|
||||
proc mkfile {path} { |
||||
file mkdir [file dirname $path] |
||||
set fd [open $path w] |
||||
puts -nonewline $fd "#fixture\n" |
||||
close $fd |
||||
} |
||||
#build a fresh fixture tree under BASE and return its path |
||||
proc mktree {name args} { |
||||
variable BASE |
||||
set root [file join $BASE $name] |
||||
file delete -force $root |
||||
file mkdir $root |
||||
foreach rel $args { |
||||
if {[string index $rel end] eq "/"} { |
||||
file mkdir [file join $root [string trimright $rel /]] |
||||
} else { |
||||
mkfile [file join $root $rel] |
||||
} |
||||
} |
||||
return $root |
||||
} |
||||
proc report {root} { |
||||
return [punkboot::utils::vfs_startup_script_report $root] |
||||
} |
||||
|
||||
#the layout/punkshell convention form: name # target # tagset # (empty comment) |
||||
variable FXMAIN {main.tcl#..+_config+kit_main.tcl#@punk%3a%3aboot,merge_over#.fxlnk} |
||||
#minimal form: name # target |
||||
variable FXMAIN2 {main.tcl#..+_config+other_main.tcl.fxlnk} |
||||
#empty nominal name - effective name is the decoded target's tail (main.tcl) |
||||
variable FXNONAME {#..+_config+main.tcl.fxlnk} |
||||
#resolves to a name that is not main.tcl |
||||
variable FXOTHER {other.tcl#..+_config+kit_main.tcl.fxlnk} |
||||
|
||||
variable common { |
||||
set result [list] |
||||
} |
||||
|
||||
# -- --- --- the clean shapes --- --- -- |
||||
|
||||
test startup_main_only {an actual root main.tcl alone is clean - status main}\ |
||||
-setup $common -body { |
||||
set r [report [mktree mainonly main.tcl lib/ modules/]] |
||||
lappend result [dict get $r ok] [dict get $r status] [dict get $r mainfile] [dict get $r mainlinks] |
||||
}\ |
||||
-result {1 main main.tcl {}} |
||||
|
||||
test startup_fauxlink_only {a root fauxlink resolving to main.tcl alone is clean - status fauxlink}\ |
||||
-setup $common -body { |
||||
variable FXMAIN |
||||
set r [report [mktree linkonly $FXMAIN modules/]] |
||||
lappend result [dict get $r ok] [dict get $r status] [dict get $r mainfile] [dict get $r mainlinks] |
||||
}\ |
||||
-result [list 1 fauxlink {} [list $FXMAIN]] |
||||
|
||||
test startup_none {no startup script at all is NOT a collision - the missing case belongs to the bake warning, not this gate}\ |
||||
-setup $common -body { |
||||
set r [report [mktree bare lib/ modules/]] |
||||
lappend result [dict get $r ok] [dict get $r status] [expr {[dict get $r reason] eq ""}] |
||||
}\ |
||||
-result {1 none 1} |
||||
|
||||
# -- --- --- the collisions --- --- -- |
||||
|
||||
test startup_collision_main_plus_fauxlink {an actual main.tcl AND a fauxlink resolving to main.tcl collide - both named in the reason}\ |
||||
-setup $common -body { |
||||
variable FXMAIN |
||||
set r [report [mktree collide1 main.tcl $FXMAIN]] |
||||
lappend result [dict get $r ok] [dict get $r status] |
||||
lappend result [string match "*main.tcl AND *$FXMAIN*" [dict get $r reason]] |
||||
lappend result [string match "*traversal order*" [dict get $r reason]] |
||||
}\ |
||||
-result {0 collision 1 1} |
||||
|
||||
test startup_collision_two_fauxlinks {two root fauxlinks both resolving to main.tcl collide even with no actual file}\ |
||||
-setup $common -body { |
||||
variable FXMAIN |
||||
variable FXMAIN2 |
||||
set r [report [mktree collide2 $FXMAIN $FXMAIN2]] |
||||
lappend result [dict get $r ok] [dict get $r status] [llength [dict get $r mainlinks]] |
||||
}\ |
||||
-result {0 collision 2} |
||||
|
||||
test startup_collision_empty_nominalname {an empty-nominalname link whose target tail is main.tcl collides - detection is by RESOLVED name}\ |
||||
-setup $common -body { |
||||
variable FXNONAME |
||||
set r [report [mktree collide3 main.tcl $FXNONAME]] |
||||
lappend result [dict get $r ok] [dict get $r status] [dict get $r mainlinks] |
||||
}\ |
||||
-result [list 0 collision [list $FXNONAME]] |
||||
|
||||
# -- --- --- what must NOT collide --- --- -- |
||||
|
||||
test startup_other_fauxlink_no_collision {a fauxlink resolving to a different name does not collide with main.tcl}\ |
||||
-setup $common -body { |
||||
variable FXOTHER |
||||
set r [report [mktree othername main.tcl $FXOTHER]] |
||||
lappend result [dict get $r ok] [dict get $r status] [dict get $r mainlinks] |
||||
}\ |
||||
-result {1 main {}} |
||||
|
||||
test startup_nested_fauxlink_exempt {a nested app/main.tcl fauxlink (undroidwish convention, G-129) is not a root supplier}\ |
||||
-setup $common -body { |
||||
variable FXMAIN |
||||
set r [report [mktree nested main.tcl app/$FXMAIN]] |
||||
lappend result [dict get $r ok] [dict get $r status] [dict get $r mainlinks] |
||||
}\ |
||||
-result {1 main {}} |
||||
|
||||
test startup_unresolvable_listed {a structurally invalid fauxlink is reported unresolvable and does not affect the verdict}\ |
||||
-setup $common -body { |
||||
set r [report [mktree badlink main.tcl notalink.fxlnk]] |
||||
lappend result [dict get $r ok] [dict get $r status] [dict get $r unresolvable] |
||||
}\ |
||||
-result {1 main notalink.fxlnk} |
||||
|
||||
# -- --- --- robustness --- --- -- |
||||
|
||||
test startup_missing_directory {a nonexistent folder is refused by name rather than erroring}\ |
||||
-setup $common -body { |
||||
variable BASE |
||||
set r [report [file join $BASE no_such_vfs]] |
||||
lappend result [dict get $r ok] [string match "no such directory:*" [dict get $r reason]] |
||||
}\ |
||||
-result {0 1} |
||||
|
||||
test startup_does_not_execute_or_write {the check writes nothing into the tree it inspects}\ |
||||
-setup $common -body { |
||||
variable FXMAIN |
||||
set root [mktree readonlycheck $FXMAIN modules/] |
||||
set before [lsort [glob -nocomplain -directory $root -tails *]] |
||||
report $root |
||||
set after [lsort [glob -nocomplain -directory $root -tails *]] |
||||
lappend result [expr {$before eq $after}] |
||||
}\ |
||||
-result {1} |
||||
|
||||
# -- --- --- the trees the gate will actually see --- --- -- |
||||
|
||||
test startup_real_source_vfs_folders {every kit source .vfs folder in this checkout is collision-free - the gate must not refuse kits that bake today}\ |
||||
-setup $common -body { |
||||
variable srcvfsfolder |
||||
set failures [list] |
||||
set checked 0 |
||||
foreach d [lsort [glob -nocomplain -type d -directory $srcvfsfolder *.vfs]] { |
||||
incr checked |
||||
set r [report $d] |
||||
if {![dict get $r ok]} { |
||||
lappend failures [list [file tail $d] [dict get $r reason]] |
||||
} |
||||
} |
||||
lappend result [expr {$checked > 0}] $failures |
||||
}\ |
||||
-result {1 {}} |
||||
|
||||
cleanupTests |
||||
} |
||||
Loading…
Reference in new issue