From 269b1af82b6c37e6df5d3939bdb5acc2a6ef292e Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Tue, 21 Jul 2026 02:56:34 +1000 Subject: [PATCH] G-095: punkcheck 0.6.0 concurrent-writer safety - atomic saves, advisory event-scoped locking Saves are write-temp-then-atomic-rename with bounded retry for Windows sharing violations; load_records_from_file retries transient open denials during a writer's replace window (parse errors stay strict - they mean real corruption). Readers gain torn-read immunity with no reader-side protocol. New punkcheck::lock namespace (PUNKARGS-documented): advisory sibling lockfile .lock via open {WRONLY CREAT EXCL}, contents naming holder pid/host/installer/timestamp, channel held open for the duration, in-process reference-counted re-acquisition (sequential make.tcl installers over one root must not self-deadlock). start_event acquires; event end / installtrack destroy releases; flushes and chokepoint saves outside an event take a transient lock. Contention retries with backoff to -timeout (env PUNKCHECK_LOCK_TIMEOUT, default 15s) then errors naming the holder; stale locks break on provably-dead holder pid (twapi process_exists / kill -0, capability-gated) or age (-staleage / PUNKCHECK_LOCK_STALEAGE, default 300s). Deferred flushes merge own records (INSTALLER by -name, touched FILEINFO by -targets) into freshly-loaded file state under the lock instead of wholesale overwrite; an mtime/size tripwire warns when a non-protocol writer (e.g. older vendored punkcheck) touched the file between load and save. Duplicate-INSTALLER recovery: clean actionable error when stdin is non-interactive (punkcheck::lib::stdin_is_interactive - strict twapi GetConsoleMode on the real stdin handle on Windows, -inputmode probe / test -t 0 on unix); the interactive prompt gains the synced-targets deletion-wedge caveat. default_excludefiletail_core adds .punkcheck.* so protocol siblings are never installable content. Consumers verified without edits: cli and five make.tcl sites end their events (lock released at end); make.tcl's vfs/bin kit flows destroy their installers on every path (destructor releases). New concurrency.test (6 tests): two child installer processes with a polling reader (no parse errors, both installers survive, no duplicate INSTALLERs, no lock/tmp leftovers), lock timeout naming the holder then success after release, dead-pid and age stale-breaks against planted lockfiles, non-interactive duplicate-INSTALLER error via pipe-stdin child, protocol-sibling exclusion pin. Matrix: Windows Tcl 9.0.3 84/84 (runtests), Windows Tcl 8.6.17 84/84 (direct tcltest drive - the runtests harness itself needs lpop under native 8.6), linux WSL tclsh 8.6.14 84/84 (native-FS staged run). punk/mix subtree unaffected (150 pass / 1 known constraint-skip). Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com --- src/modules/punkcheck-999999.0a1.0.tm | 517 ++++++++++++++++-- src/modules/punkcheck-buildversion.txt | 3 +- .../testsuites/punkcheck/concurrency.test | 319 +++++++++++ 3 files changed, 784 insertions(+), 55 deletions(-) create mode 100644 src/tests/modules/punkcheck/testsuites/punkcheck/concurrency.test diff --git a/src/modules/punkcheck-999999.0a1.0.tm b/src/modules/punkcheck-999999.0a1.0.tm index 1ee3f912..5684014b 100644 --- a/src/modules/punkcheck-999999.0a1.0.tm +++ b/src/modules/punkcheck-999999.0a1.0.tm @@ -73,7 +73,8 @@ namespace eval punkcheck { proc default_excludefiletail_core {} { variable default_excludefiletail_core if {$default_excludefiletail_core eq ""} { - set default_excludefiletail_core [list "*.swp" "*[punk::mix::util::tm_version_magic]*" "*-buildversion.txt" ".punkcheck"] + #.punkcheck.* covers the G-095 protocol siblings (.punkcheck.lock, .punkcheck.tmp.) + set default_excludefiletail_core [list "*.swp" "*[punk::mix::util::tm_version_magic]*" "*-buildversion.txt" ".punkcheck" ".punkcheck.*"] } return $default_excludefiletail_core } @@ -82,7 +83,25 @@ namespace eval punkcheck { proc load_records_from_file {punkcheck_file} { set record_list [list] if {[file exists $punkcheck_file]} { - set tdlscript [punk::mix::util::fcat $punkcheck_file] + #G-095: the atomic-rename save keeps content untorn, but on Windows a reader's open can + #transiently be denied while a writer's MoveFileEx replace is in flight - retry the read + #with backoff. Parse errors stay strict (they indicate real corruption, never a race). + set backoff 10 + set deadline [expr {[clock milliseconds] + 2000}] + while {1} { + if {![catch {punk::mix::util::fcat $punkcheck_file} tdlscript]} { + break + } + if {![file exists $punkcheck_file]} { + #genuinely deleted between our checks - same as never present + return $record_list + } + if {[clock milliseconds] >= $deadline} { + error "punkcheck::load_records_from_file failed to read '$punkcheck_file'\n error:$tdlscript" + } + after $backoff + set backoff [expr {min($backoff * 2,100)}] + } if {[catch { set record_list [punk::tdl::prettyparse $tdlscript] } errparse]} { @@ -98,18 +117,251 @@ namespace eval punkcheck { if {$debugchannel ne "" && $trigger ne ""} { puts $debugchannel "\x1b\[36mSaving [llength $recordlist] records as $linecount lines to file '$punkcheck_file' trigger: \x1b\[32m$trigger\x1b\[m" } - #puts stdout $newtdl - set fd [open $punkcheck_file w] + #G-095: write-temp-then-atomic-rename so readers never observe torn content. + #The temp file lives in the same directory (same volume) as the target; the rename is retried + #with backoff for Windows sharing violations (a concurrent reader holding the target open). + set tmpfile "${punkcheck_file}.tmp.[pid]" + set fd [open $tmpfile w] chan configure $fd -translation binary puts -nonewline $fd $newtdl flush $fd close $fd + set renamed 0 + set backoff 20 + set deadline [expr {[clock milliseconds] + 2000}] + while {1} { + if {![catch {file rename -force -- $tmpfile $punkcheck_file} errRename]} { + set renamed 1 + break + } + if {[clock milliseconds] >= $deadline} { + break + } + after $backoff + set backoff [expr {min($backoff * 2,250)}] + } + if {!$renamed} { + catch {file delete -- $tmpfile} + error "punkcheck::save_records_to_file failed to atomically replace '$punkcheck_file' (trigger: $trigger) - last rename error: $errRename" + } + #hygiene: clear abandoned temp files from crashed/killed writers (age-gated; own pattern only) + foreach leftover [glob -nocomplain -types f -- "${punkcheck_file}.tmp.*"] { + if {![catch {file mtime $leftover} lmt] && ([clock seconds] - $lmt) > 600} { + catch {file delete -- $leftover} + } + } return [list recordcount [llength $recordlist] linecount $linecount] } + #----------------------------------------------- + #G-095 advisory lockfile protocol: serializes whole installer events per punkcheck root. + #Cross-platform primitive: open {WRONLY CREAT EXCL} is an atomic create-new on Windows and + #POSIX under Tcl 8.6 and 9 with no extra packages. The holder keeps the channel open for the + #lock's duration (on Windows an open handle also resists deletion by other processes). + #In-process re-acquisition is reference-counted: sequential installtrack instances over one + #.punkcheck file in one process are an established make.tcl pattern and must not self-deadlock. + #The lock is advisory - readers (punkcheck::cli status, load_records_from_file) never take it; + #their torn-read immunity comes from the atomic rename in save_records_to_file. + namespace eval lock { + namespace path ::punkcheck + variable held + if {![info exists held]} { + set held [dict create] ;#normalized lockfile path -> dict {channel refcount } + } + + namespace eval argdoc { + lappend PUNKARGS [list { + @id -id ::punkcheck::lock::acquire + @cmd -name "punkcheck::lock::acquire"\ + -summary\ + "Acquire the advisory event lock for a punkcheck file."\ + -help\ + "Acquires the advisory sibling lockfile .lock via an atomic + create-new open, serializing whole installer events per punkcheck root + across processes. The holder identity (pid/host/installer/timestamp) is + written into the lockfile and the channel is held open for the lock's + duration. In-process re-acquisition is reference-counted. + On contention the acquisition retries with backoff until -timeout, breaking + stale locks early (provably-dead holder pid on this host when a liveness + capability is present, or lockfile age beyond -staleage), then errors with + errorcode {PUNKCHECK LOCK TIMEOUT } naming the holder. + Returns a token for punkcheck::lock::release. + The lock is advisory: readers never take it (torn-read immunity comes from + the atomic-rename save)." + @leaders -min 1 -max 1 + punkcheck_file -type file -help\ + "Path of the .punkcheck file whose sibling lockfile governs the root." + @opts + -timeout -type integer -help\ + "Milliseconds to keep retrying on contention before erroring. + Default 15000, or env(PUNKCHECK_LOCK_TIMEOUT) when set." + -staleage -type integer -help\ + "Seconds beyond which a contended lockfile is broken on age alone. + Default 300, or env(PUNKCHECK_LOCK_STALEAGE) when set." + -installer -type string -default "" -help\ + "Holder identity recorded in the lockfile contents." + -warnchannel -type string -default stderr -help\ + "Channel receiving stale-break warnings." + }] + lappend PUNKARGS [list { + @id -id ::punkcheck::lock::release + @cmd -name "punkcheck::lock::release"\ + -summary\ + "Release a token from punkcheck::lock::acquire."\ + -help\ + "Reference-counted: the lockfile channel is closed and the file deleted when + the in-process count reaches zero. Unknown tokens return 0 (idempotent for + cleanup paths); handled tokens return 1." + @values -min 1 -max 1 + token -type string -help\ + "Token returned by punkcheck::lock::acquire." + }] + } + + #acquire the advisory event lock for a punkcheck file. Returns a token for release. + # -timeout ms to keep retrying on contention before erroring (names the holder) + # -staleage seconds after which a contended lockfile is broken on age alone + # -installer holder identity recorded in the lockfile contents + #env overrides PUNKCHECK_LOCK_TIMEOUT / PUNKCHECK_LOCK_STALEAGE apply when options are not passed. + proc acquire {punkcheck_file args} { + variable held + set default_timeout 15000 + set default_staleage 300 + if {[info exists ::env(PUNKCHECK_LOCK_TIMEOUT)] && [string is integer -strict $::env(PUNKCHECK_LOCK_TIMEOUT)]} { + set default_timeout $::env(PUNKCHECK_LOCK_TIMEOUT) + } + if {[info exists ::env(PUNKCHECK_LOCK_STALEAGE)] && [string is integer -strict $::env(PUNKCHECK_LOCK_STALEAGE)]} { + set default_staleage $::env(PUNKCHECK_LOCK_STALEAGE) + } + set defaults [dict create -timeout $default_timeout -staleage $default_staleage -installer "" -warnchannel stderr] + if {[llength $args] % 2} { + error "punkcheck::lock::acquire arguments after punkcheck_file must be -flag value pairs. known flags: [dict keys $defaults]" + } + foreach {k v} $args { + if {$k ni [dict keys $defaults]} { + error "punkcheck::lock::acquire unrecognised flag '$k'. known flags: [dict keys $defaults]" + } + } + set opts [dict merge $defaults $args] + set timeout [dict get $opts -timeout] + set staleage [dict get $opts -staleage] + set installer [dict get $opts -installer] + set warnchannel [dict get $opts -warnchannel] + + set lockfile [file normalize "${punkcheck_file}.lock"] + if {[dict exists $held $lockfile]} { + #in-process re-acquisition (sequential or nested installers on one punkcheck root) + dict set held $lockfile refcount [expr {[dict get $held $lockfile refcount] + 1}] + return $lockfile + } + set deadline [expr {[clock milliseconds] + $timeout}] + set backoff 50 + while {1} { + if {![catch {open $lockfile {WRONLY CREAT EXCL}} fd]} { + chan configure $fd -translation lf + set holderinfo [dict create pid [pid] host [info hostname] installer $installer tsiso [clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"] ts [clock microseconds]] + puts $fd $holderinfo + flush $fd + dict set held $lockfile [dict create channel $fd refcount 1] + return $lockfile + } + #contended - identify the holder (best effort: the file can vanish between the + #failed EXCL open and this read) + set holderinfo "" + catch { + set rfd [open $lockfile r] + set holderinfo [string trim [read $rfd]] + close $rfd + } + set holder_pid "" + set holder_host "" + if {[llength $holderinfo] % 2 == 0} { + set holder_pid [dict_getwithdefault $holderinfo pid ""] + set holder_host [dict_getwithdefault $holderinfo host ""] + } + set broke 0 + #liveness stale-break: holder recorded on this host and provably dead (capability-gated) + if {[string is integer -strict $holder_pid] && $holder_host eq [info hostname] && $holder_pid != [pid]} { + if {[pid_liveness $holder_pid] eq "dead"} { + catch {puts $warnchannel "punkcheck::lock warning: breaking stale lock '$lockfile' - holder pid $holder_pid on this host is no longer running (holder: $holderinfo)"} + catch {file delete -- $lockfile} + set broke 1 + } + } + if {!$broke} { + #age-based stale-break: the portable baseline + if {[catch {file mtime $lockfile} lockmtime]} { + #lockfile vanished since the failed open - retry immediately + set broke 1 + } elseif {([clock seconds] - $lockmtime) > $staleage} { + catch {puts $warnchannel "punkcheck::lock warning: breaking stale lock '$lockfile' - older than ${staleage}s (holder: $holderinfo)"} + catch {file delete -- $lockfile} + set broke 1 + } + } + if {!$broke} { + if {[clock milliseconds] >= $deadline} { + if {$holderinfo eq ""} { + set holderdesc "(holder unknown - lockfile unreadable)" + } else { + set holderdesc $holderinfo + } + return -code error -errorcode [list PUNKCHECK LOCK TIMEOUT $lockfile] "punkcheck::lock::acquire timeout after ${timeout}ms waiting for '$lockfile' held by: $holderdesc" + } + after $backoff + set backoff [expr {min($backoff * 2,500)}] + } + } + } + #release a token from acquire. Reference-counted; the lockfile is closed and deleted when + #the count reaches zero. Unknown tokens return 0 (idempotent for cleanup paths). + proc release {token} { + variable held + if {![dict exists $held $token]} { + return 0 + } + set refcount [expr {[dict get $held $token refcount] - 1}] + if {$refcount > 0} { + dict set held $token refcount $refcount + return 1 + } + catch {close [dict get $held $token channel]} + catch {file delete -- $token} + dict unset held $token + return 1 + } + #alive | dead | unknown for a pid on this host (capability-gated liveness) + proc pid_liveness {pid} { + if {"windows" eq $::tcl_platform(platform)} { + if {![catch {package require twapi}]} { + if {[catch {twapi::process_exists $pid} exists]} { + return unknown + } + return [expr {$exists ? "alive" : "dead"}] + } + return unknown + } else { + if {![catch {exec kill -0 $pid}]} { + return alive + } else { + #kill -0 errors for both nonexistent (No such process) and not-permitted (alive, + #other user) - only the former is a confident 'dead' + catch {exec kill -0 $pid} errkill + if {[string match -nocase "*no such process*" $errkill]} { + return dead + } + return unknown + } + } + } + } + - #Concurrent multi-process writers of one .punkcheck file are G-095's scope - the single save chokepoint - #(installtrack method save_working_recordset) is the attachment point for its locking/atomic-rename/merge measures. + #Concurrent multi-process writer safety (G-095) lives at the single save chokepoint (installtrack + #method save_working_recordset) and its callers: saves are write-temp-then-atomic-rename, whole + #installer events hold the advisory .punkcheck.lock (punkcheck::lock, start_event through end), + #deferred flushes merge own records into freshly-loaded file state, and an optimistic + #mtime/size tripwire warns when a non-protocol writer touched the file between load and save. #an installtrack object represents an installation path from sourceroot to targetroot #The source and target folders should be as specific as possible but it is valid to specify for example c:/ -> c:/ (or / -> /) if source and targets within the installation operation are spread around. # @@ -241,7 +493,9 @@ namespace eval punkcheck { punkcheck::recordlist::records_as_target_dict [$o_installer get_recordlist] } #merge the event's current fileset record into the parent installtrack's working recordset - #(replace the record with matching -targets, or append when absent) + #(replace the record with matching -targets, or append when absent). The parent also + #records the targetlist as touched - the 'own records' set its merge-on-flush carries + #into freshly-loaded file state. method MergeFilesetToWorking {} { set record_list [$o_installer get_recordlist] set targetlist [dict get $o_fileset_record -targets] @@ -253,6 +507,7 @@ namespace eval punkcheck { lset record_list $old_posn $o_fileset_record } $o_installer set_recordlist $record_list + $o_installer touched_target $targetlist } #call init before we know if we are going to run the operation vs skip @@ -551,9 +806,15 @@ namespace eval punkcheck { variable o_active_event variable o_events variable o_debugchannel + variable o_event_lock ;#advisory lock token while an event (or transient flush) holds it + variable o_touched_targets ;#targetlists this instance's events merged - the 'own records' set for merge-on-flush + variable o_load_sig ;#file signature {mtime size} at last load - optimistic tripwire vs non-protocol writers constructor {installername punkcheck_file {debugchannel ""}} { set o_debugchannel $debugchannel set o_active_event "" + set o_event_lock "" + set o_touched_targets [dict create] + set o_load_sig "" set o_name $installername set o_checkfile [file normalize $punkcheck_file] @@ -592,12 +853,22 @@ namespace eval punkcheck { } } if {$insane ne ""} { + if {![punkcheck::lib::stdin_is_interactive]} { + #G-095: unattended runs get a clean actionable error instead of a prompt + #that would block on open stdin or mis-answer on closed/piped stdin + set errmsg "punkcheck installtrack sanity check failed: punkcheck file '$o_checkfile' contains multiple INSTALLER records with -name '$insane'." + append errmsg \n "Likely cause: concurrent writers racing the file (writers predating the G-095 lock protocol) or an interrupted run." + append errmsg \n "Session is non-interactive - not prompting. Recovery: inspect the file, or delete it and rerun." + append errmsg \n "Deleting loses install history and checksums (unnecessary recopies next run); for synced-targets consumers (e.g bin/ deploys) existing targets then skip until manually reconciled, since skipped records never store target cksums." + error $errmsg + } set msg "Sanity check: punkcheck file '$o_checkfile' contains multiple records for INSTALLER -name '$insane'." append msg \n "This may indicate a problem such as multiple concurrent installtrack instances using the same punkcheck file," append msg \n " or a previous installtrack instance that did not complete properly." append msg \n " Do you want to DELETE the .punkcheck file?" append msg \n " It is safe to delete .punkcheck files, at the cost of loss of history and checksums used to optimize installs." append msg \n " They are a record of installation events and checksums used to avoid unnecessary reinstalls." + append msg \n " Caveat: for synced-targets consumers (e.g bin/ deploys) deletion wedges existing targets into skip-until-manually-reconciled - skipped records never store the target cksums that mode compares against." append msg \n " If not confirmed, an error will be raised - likely aborting the current operation." append msg \n "confirm deletion and continue by regenerating the file, by typing the 3 letters: 'yes'." set answer [punk::lib::askuser $msg] @@ -651,7 +922,11 @@ namespace eval punkcheck { } destructor { - #puts "[self] destructor called" + #release any lock still held (an abandoned event, or an error path that skipped end) + if {$o_event_lock ne ""} { + catch {punkcheck::lock::release $o_event_lock} + set o_event_lock "" + } } method test {} { return [self] @@ -685,6 +960,14 @@ namespace eval punkcheck { #review/fix to allow multiple installtrack objects on same punkcheck file. method load_all_records {} { set o_record_list [punkcheck::load_records_from_file $o_checkfile] + set o_load_sig [my Checkfile_signature] + } + #file signature for the optimistic tripwire ({} when the file doesn't exist yet) + method Checkfile_signature {} { + if {[catch {list [file mtime $o_checkfile] [file size $o_checkfile]} sig]} { + return {} + } + return $sig } #does not include associated FILEINFO records - as a targetset (FILEINFO record) can be associated with events from multiple installers over time. @@ -710,27 +993,93 @@ namespace eval punkcheck { method set_recordlist {records} { set o_record_list $records } + #record a targetlist as touched by this instance's events - the 'own records' set that + #merge-on-flush carries into freshly-loaded file state + method touched_target {targetlist} { + dict set o_touched_targets $targetlist 1 + } + method lock_held {} { + return [expr {$o_event_lock ne ""}] + } #single save chokepoint: every .punkcheck write from the record lifecycle funnels through here. - #G-095 (concurrent-writer safety: locking, atomic rename, merge-on-flush) attaches at this point. + #G-095 measures live here: the write itself is write-temp-then-atomic-rename + #(save_records_to_file), a caller without the event lock gets a transient one, and the + #optimistic tripwire warns when the file changed on disk since this installer last loaded + #it (a writer bypassing the advisory protocol - e.g an older vendored punkcheck during + #the transition window). method save_working_recordset {{trigger save_working_recordset}} { - punkcheck::save_records_to_file $o_record_list $o_checkfile $trigger $o_debugchannel + set transient 0 + if {$o_event_lock eq ""} { + set o_event_lock [punkcheck::lock::acquire $o_checkfile -installer $o_name] + set transient 1 + } + try { + set current_sig [my Checkfile_signature] + if {$o_load_sig ne {} && $current_sig ne {} && $current_sig ne $o_load_sig} { + catch {puts stderr "punkcheck warning: '$o_checkfile' changed on disk since this installer last loaded it (advisory lock protocol bypassed by another writer?) - saving anyway (trigger: $trigger installer: $o_name)"} + } + set saveresult [punkcheck::save_records_to_file $o_record_list $o_checkfile $trigger $o_debugchannel] + set o_load_sig [my Checkfile_signature] + return $saveresult + } finally { + if {$transient} { + punkcheck::lock::release $o_event_lock + set o_event_lock "" + } + } } - #sync this installer's own record (from the live event objects) into the working recordset, - #prune unreferenced events beyond -keep_events, and persist via the chokepoint. - #This is the event-scoped persistence point for deferred events. + #sync this installer's own records into freshly-loaded file state and persist via the + #chokepoint - the event-scoped persistence point for deferred events. + #Merge-on-flush (G-095): the file is re-loaded under the lock and only this installer's + #own records are carried over - the INSTALLER record by -name and touched FILEINFO + #records by -targets - so records other processes wrote since our load are preserved + #instead of being wholesale-overwritten. method flush {{trigger flush}} { - set this_installer_record [my as_record] - set persistedinfo [punkcheck::recordlist::get_installer_record $o_name $o_record_list] - set existing_header_posn [dict get $persistedinfo position] - if {$existing_header_posn == -1} { - ledit o_record_list -1 -1 $this_installer_record - set existing_header_posn 0 - } else { - lset o_record_list $existing_header_posn $this_installer_record + set transient 0 + if {$o_event_lock eq ""} { + set o_event_lock [punkcheck::lock::acquire $o_checkfile -installer $o_name] + set transient 1 + } + try { + #fresh file state under the lock + set base [punkcheck::load_records_from_file $o_checkfile] + #merge own FILEINFO records (by -targets) + foreach targetlist [dict keys $o_touched_targets] { + set owninfo [punkcheck::recordlist::get_file_record $targetlist $o_record_list] + if {[dict get $owninfo position] == -1} { + continue + } + set ownrec [dict get $owninfo record] + set baseinfo [punkcheck::recordlist::get_file_record $targetlist $base] + set base_posn [dict get $baseinfo position] + if {$base_posn == -1} { + lappend base $ownrec + } else { + lset base $base_posn $ownrec + } + } + #merge own INSTALLER record (by -name), event-pruned against the merged set + set this_installer_record [my as_record] + set persistedinfo [punkcheck::recordlist::get_installer_record $o_name $base] + set existing_header_posn [dict get $persistedinfo position] + if {$existing_header_posn == -1} { + ledit base -1 -1 $this_installer_record + set existing_header_posn 0 + } else { + lset base $existing_header_posn $this_installer_record + } + set this_installer_record [punkcheck::recordlist::installer_record_pruneevents $this_installer_record $base] + lset base $existing_header_posn $this_installer_record + + set o_record_list $base + set o_load_sig [my Checkfile_signature] + my save_working_recordset $trigger + } finally { + if {$transient} { + punkcheck::lock::release $o_event_lock + set o_event_lock "" + } } - set this_installer_record [punkcheck::recordlist::installer_record_pruneevents $this_installer_record $o_record_list] - lset o_record_list $existing_header_posn $this_installer_record - my save_working_recordset $trigger } #save the working recordset (installer record synced) - historical name retained. method save_all_records {} { @@ -765,38 +1114,55 @@ namespace eval punkcheck { set opts [dict merge $defaults $args] set persistence [dict get $opts -persistence] - #refresh the working recordset from the file so this event starts from persisted state. - #(coherence: a prior event's targetset writes - eager per-op saves or a deferred flush - must not - # be discarded by saving a stale constructor-era recordset here. Unflushed deferred updates are - # deliberately abandoned by this refresh - an ended deferred event that wasn't flushed chose not - # to persist.) - my load_all_records - set resultinfo [punkcheck::recordlist::get_installer_record $o_name $o_record_list] - set existing_header_posn [dict get $resultinfo position] - if {$existing_header_posn == -1} { - #no persisted installer record yet (first event since construction - the constructor only - #creates the record in memory; this save is the first write) - set this_installer_record [punkcheck::recordlist::new_installer_record $o_name] - ledit o_record_list -1 -1 $this_installer_record - set existing_header_posn 0 - } else { - set this_installer_record [dict get $resultinfo record] - } + #G-095: acquire the advisory event lock before reading - held from here until the + #event ends (event_ended releases). This serializes whole installer events per + #punkcheck root across processes; in-process sequential installers re-enter via the + #lock registry's refcount. + set acquired_here 0 + if {$o_event_lock eq ""} { + set o_event_lock [punkcheck::lock::acquire $o_checkfile -installer $o_name] + set acquired_here 1 + } + try { + #refresh the working recordset from the file so this event starts from persisted state. + #(coherence: a prior event's targetset writes - eager per-op saves or a deferred flush - must not + # be discarded by saving a stale constructor-era recordset here. Unflushed deferred updates are + # deliberately abandoned by this refresh - an ended deferred event that wasn't flushed chose not + # to persist.) + my load_all_records + set resultinfo [punkcheck::recordlist::get_installer_record $o_name $o_record_list] + set existing_header_posn [dict get $resultinfo position] + if {$existing_header_posn == -1} { + #no persisted installer record yet (first event since construction - the constructor only + #creates the record in memory; this save is the first write) + set this_installer_record [punkcheck::recordlist::new_installer_record $o_name] + ledit o_record_list -1 -1 $this_installer_record + set existing_header_posn 0 + } else { + set this_installer_record [dict get $resultinfo record] + } - set eventobj [punkcheck::installevent create [namespace current]::event_[my events count] [self] $o_rel_sourceroot $o_rel_targetroot -config $configdict -persistence $persistence] - set eventid [$eventobj get_id] - set event_record [$eventobj as_record] + set eventobj [punkcheck::installevent create [namespace current]::event_[my events count] [self] $o_rel_sourceroot $o_rel_targetroot -config $configdict -persistence $persistence] + set eventid [$eventobj get_id] + set event_record [$eventobj as_record] - set this_installer_record [punkcheck::recordlist::installer_record_add_event $this_installer_record $event_record] - set this_installer_record [punkcheck::recordlist::installer_record_pruneevents $this_installer_record $o_record_list] + set this_installer_record [punkcheck::recordlist::installer_record_add_event $this_installer_record $event_record] + set this_installer_record [punkcheck::recordlist::installer_record_pruneevents $this_installer_record $o_record_list] - #replace - lset o_record_list $existing_header_posn $this_installer_record + #replace + lset o_record_list $existing_header_posn $this_installer_record - my save_working_recordset "start_event $eventid" - set o_active_event $eventobj - my events add $eventobj $eventid - return $eventobj + my save_working_recordset "start_event $eventid" + set o_active_event $eventobj + my events add $eventobj $eventid + return $eventobj + } on error {result erropts} { + if {$acquired_here && $o_event_lock ne ""} { + catch {punkcheck::lock::release $o_event_lock} + set o_event_lock "" + } + return -options $erropts $result + } } method installer_record_from_file {} { set resultinfo [punkcheck::recordlist::get_installer_record $o_name $o_record_list] @@ -811,10 +1177,15 @@ namespace eval punkcheck { $o_active_event end } #called by installevent end - clears the active slot so a subsequent start_event on this - #installtrack is valid (sequential events on one instance) + #installtrack is valid (sequential events on one instance), and releases the advisory + #event lock (G-095: lock scope is the whole installer event, start_event through end) method event_ended {eventobj} { if {$o_active_event eq $eventobj} { set o_active_event "" + if {$o_event_lock ne ""} { + catch {punkcheck::lock::release $o_event_lock} + set o_event_lock "" + } } } method get_event {} { @@ -869,6 +1240,17 @@ namespace eval punkcheck { append msg " call \$installer flush to persist (event-scoped batch save - punkcheck::install uses this)." \n append msg " An ended deferred event that was never flushed deliberately discards its record updates." \n append msg " QUERY operations are never persisted in either mode." \n + append msg "" \n + append msg "Concurrent-writer safety (G-095):" \n + append msg " Saves are write-temp-then-atomic-rename - readers never see torn content." \n + append msg " start_event acquires the advisory sibling lockfile .lock (released at event" \n + append msg " end), serializing whole installer events per punkcheck root across processes; flushes and" \n + append msg " chokepoint saves outside an event take a transient lock. Contention retries with backoff" \n + append msg " until timeout, then errors naming the holder (pid/host/installer/timestamp from the" \n + append msg " lockfile). Stale locks break on provably-dead holder pid (capability-gated) or age." \n + append msg " Env overrides: PUNKCHECK_LOCK_TIMEOUT (ms, default 15000), PUNKCHECK_LOCK_STALEAGE" \n + append msg " (seconds, default 300). Deferred flushes merge own records (INSTALLER by -name," \n + append msg " touched FILEINFO by -targets) into freshly-loaded file state." \n return $msg } #todo - ensure that removing a dependency is noticed as a change @@ -1143,6 +1525,33 @@ namespace eval punkcheck { proc path_relative {base dst} { return [punk::path::relative $base $dst] } + + #Is stdin a terminal a user can be prompted on? (G-095: the duplicate-INSTALLER recovery + #must not block or garble unattended runs with an interactive prompt.) + #Detection is tiered and defaults to NOT interactive when no probe is available - the + #non-interactive path raises a clean actionable error, which an interactive user can act + #on just as well, whereas a prompt in an unattended run blocks or mis-answers. + proc stdin_is_interactive {} { + if {"windows" eq $::tcl_platform(platform)} { + #strict check on the actual std handle: GetConsoleMode errors for pipe/file/NUL + #stdin (twapi::get_console_handle is unsuitable - it succeeds for piped children + #of console shells; same finding as runtests.tcl colour autodetection) + if {![catch {package require twapi}]} { + return [expr {![catch {twapi::GetConsoleMode [twapi::GetStdHandle -10]}]}] + } + return 0 + } else { + #tcl 9 (and 8.7) unix terminal channels expose -inputmode; pipes/files do not + if {[dict exists [chan configure stdin] -inputmode]} { + return 1 + } + #tcl 8.6 unix: POSIX test(1) isatty on fd 0 + if {![catch {exec test -t 0 <@stdin}]} { + return 1 + } + return 0 + } + } } #skip writing punkcheck during checksum/timestamp checks @@ -2354,7 +2763,7 @@ namespace eval punkcheck { namespace eval ::punk::args::register { #use fully qualified so 8.6 doesn't find existing var in global namespace - lappend ::punk::args::register::NAMESPACES ::punkcheck + lappend ::punk::args::register::NAMESPACES ::punkcheck ::punkcheck::lock } diff --git a/src/modules/punkcheck-buildversion.txt b/src/modules/punkcheck-buildversion.txt index 935111b7..422d65c6 100644 --- a/src/modules/punkcheck-buildversion.txt +++ b/src/modules/punkcheck-buildversion.txt @@ -1,6 +1,7 @@ -0.5.0 +0.6.0 #First line must be a semantic version number #all other lines are ignored. +#0.6.0 - G-095 concurrent-writer safety: saves are write-temp-then-atomic-rename (bounded retry for Windows sharing violations) so readers never see torn content, and load_records_from_file retries transient open denials during a writer's replace window (parse errors stay strict). New punkcheck::lock namespace: advisory sibling lockfile .lock (open WRONLY CREAT EXCL, holder pid/host/installer/timestamp contents, channel held open, in-process refcounted re-acquisition) serializes whole installer events - acquired at start_event, released at event end / installtrack destroy; flushes and chokepoint saves outside an event take a transient lock; contention retries with backoff to -timeout (env PUNKCHECK_LOCK_TIMEOUT) then errors naming the holder (errorcode PUNKCHECK LOCK TIMEOUT); stale locks break on provably-dead holder pid (twapi/kill -0, capability-gated) or age (-staleage / PUNKCHECK_LOCK_STALEAGE). Deferred flushes merge own records (INSTALLER by -name, touched FILEINFO by -targets) into freshly-loaded file state instead of wholesale overwrite; an mtime/size tripwire warns when a non-protocol writer touched the file between load and save. Duplicate-INSTALLER recovery degrades to a clean actionable error when stdin is non-interactive (new punkcheck::lib::stdin_is_interactive; twapi GetConsoleMode on the real stdin handle / unix -inputmode / test -t 0), and the interactive prompt gains the synced-targets deletion-wedge caveat. default_excludefiletail_core adds .punkcheck.* so lock/temp siblings are never treated as installable content. #0.5.0 - G-094 single record lifecycle: installtrack/installevent OO layer is the sole implementation (targetset init/add-source/started/end) with a per-event persistence policy (start_event ?-persistence eager|deferred?; deferred = in-memory working recordset + $installer flush, the mode punkcheck::install now uses as a tree-walking OO consumer). Legacy proc pipeline (start_installer_event, installfile_begin/started_install/finished_install/skipped_install) retired to error-with-pointer shims. All saves flow through one chokepoint (installtrack save_working_recordset - G-095 attachment point). Fixes: start_event refreshes the working recordset (sequential events no longer clobber prior targetset writes; end/end_event now clears the active event so sequential events work), installtrack as_record no longer writes -name with a trailing space, event reconstruction maps -ts_begin/-ts_end (flush no longer rewrites prior event history timestamps), get_recordlist misspelled variable, targetset_dict called a nonexistent helper. punkcheck::install records now carry -metadata_us/-ts_start_transfer/-transfer_us/-cksum_us like OO-installed records, and all-targets mode now stores -targets_cksums. recordlist::extract_or_create_fileset_record no longer prints to stdout (isnew returned; targetset_init reports via debugchannel). Dead targetset class removed. #0.4.0 - cross-root sources: installfile_add_source_and_fetch_metadata now records sources that share no common root with the punkcheck folder (e.g //zipfs:/ module-mounted sources installing to the filesystem) as independent absolute paths via the cksum helpers' empty-base mode, instead of erroring 'don't share a common root'. Enables punkcheck::install from module-carried (vfs-mounted) layout payloads - G-087 stage 3 bare-kit project generation. #0.3.2 - fix: start_installer_event built its EVENT header record from a braced literal, writing the literal strings '$eventid' '$rel_source' '$rel_target' '$config' into every punkcheck::install event header instead of the values. Readers matching on the returned eventid masked it, but any two such events in one file collide on the duplicate literal id when punkcheck::installtrack loads the file (first hit: G-087 stage 3 sharing src/project_layouts/.punkcheck between install and installtrack writers), and event -source/-targets/-config provenance metadata was unrecorded. diff --git a/src/tests/modules/punkcheck/testsuites/punkcheck/concurrency.test b/src/tests/modules/punkcheck/testsuites/punkcheck/concurrency.test new file mode 100644 index 00000000..068dd433 --- /dev/null +++ b/src/tests/modules/punkcheck/testsuites/punkcheck/concurrency.test @@ -0,0 +1,319 @@ +# -*- tcl -*- +# G-095 concurrency tests for punkcheck: atomic saves, advisory event-scoped locking, +# stale-lock breaking, and the non-interactive duplicate-INSTALLER recovery. +# Drives real child processes of the same interpreter against one .punkcheck folder. +# Run: tclsh src/tests/runtests.tcl -report compact -show-passes 0 -include-paths modules/punkcheck/*** concurrency.test + +package require tcltest +package require punkcheck +package require punk::lib + +namespace eval ::testspace { + namespace import ::tcltest::* + + # ------------------------------------------------------------------------- + # Capability constraints + # ------------------------------------------------------------------------- + # child-process facility: can we exec the running interpreter with a script? + set can_exec_child 0 + set probe_script [file join [punk::lib::tempdir_newfolder -prefix pkccprobe] probe.tcl] + set fd [open $probe_script w] + puts $fd {puts PROBE-OK} + close $fd + if {![catch {exec [info nameofexecutable] $probe_script} probe_out] && [string match *PROBE-OK* $probe_out]} { + set can_exec_child 1 + } + file delete -force [file dirname $probe_script] + tcltest::testConstraint canexecchild $can_exec_child + + # pid-liveness capability (twapi on windows, kill -0 on unix) - the dead-pid stale-break + # test depends on a confident 'dead' verdict being available + tcltest::testConstraint haspidliveness [expr {[punkcheck::lock::pid_liveness [pid]] eq "alive"}] + + # ------------------------------------------------------------------------- + # Helpers + # ------------------------------------------------------------------------- + proc make_workspace {} { + set root [punk::lib::tempdir_newfolder -prefix pkconctest] + set punkcheck_file [file join $root .punkcheck] + set srcdir [file join $root src] + set tgtdir [file join $root tgt] + file mkdir $srcdir $tgtdir + return [dict create root $root punkcheck_file $punkcheck_file srcdir $srcdir tgtdir $tgtdir] + } + proc write_file {path content} { + file mkdir [file dirname $path] + set fd [open $path w] + chan configure $fd -translation lf + try { puts -nonewline $fd $content } finally { close $fd } + return $path + } + #script preamble reproducing this interpreter's module search state in a child process + proc child_preamble {} { + set preamble "package prefer latest\n" + foreach p [lreverse [tcl::tm::path list]] { + append preamble "tcl::tm::path add [list $p]\n" + } + append preamble "set ::auto_path [list $::auto_path]\n" + append preamble "package require punkcheck\n" + return $preamble + } + #poll for a condition script returning true; fail with $what after $deadline_ms + proc poll_until {condition deadline_ms what} { + set deadline [expr {[clock milliseconds] + $deadline_ms}] + while {![uplevel 1 $condition]} { + if {[clock milliseconds] >= $deadline} { + error "timeout waiting for: $what" + } + after 25 + } + } + + #added 2026-07-21 (agent, G-095) - concurrency suite: atomic saves, advisory event lock, stale-break, non-interactive recovery + + # ========================================================================= + # --- two concurrent installer processes: no corruption, no lost records --- + # ========================================================================= + + test concurrency_two_writers_no_corruption {two child installer processes: file parses throughout, both installers' records survive, no duplicate INSTALLERs}\ + -constraints canexecchild\ + -body { + set ws [make_workspace] + set root [dict get $ws root] + set pf [dict get $ws punkcheck_file] + write_file [file join $root common_src.txt] "shared-source-content" + set writer [file join $root writer.tcl] + set script [child_preamble] + append script { + lassign $argv pf root name + for {set ev 0} {$ev < 3} {incr ev} { + set installer [punkcheck::installtrack new $name $pf] + $installer set_source_target $root/src $root/tgt + set event [$installer start_event [list -step $name$ev]] + foreach t {a b} { + set target ${name}_${ev}_${t}.txt + $event targetset_init INSTALL $target + $event targetset_addsource $root/common_src.txt + $event targetset_started + set fd [open $root/$target w] + puts -nonewline $fd "payload-$name-$ev-$t" + close $fd + $event targetset_end OK + } + $installer end_event + $installer destroy + after 10 + } + set fd [open $root/done_$name w] + close $fd + puts DONE-$name + } + write_file $writer $script + set exe [info nameofexecutable] + exec $exe $writer $pf $root WRA > $root/outA.log 2>@1 & + exec $exe $writer $pf $root WRB > $root/outB.log 2>@1 & + #polling reader: every load must parse cleanly (atomic renames - no torn reads) + set parse_errors [list] + set observed_loads 0 + set deadline [expr {[clock milliseconds] + 60000}] + while {!([file exists $root/done_WRA] && [file exists $root/done_WRB])} { + if {[clock milliseconds] >= $deadline} { + set loga "" ; set logb "" + catch {set loga [punk::mix::util::fcat $root/outA.log]} + catch {set logb [punk::mix::util::fcat $root/outB.log]} + error "timeout waiting for writer children. A: $loga B: $logb" + } + if {[file exists $pf]} { + if {[catch {punkcheck::load_records_from_file $pf} r]} { + lappend parse_errors $r + } else { + incr observed_loads + } + } + after 20 + } + set records [punkcheck::load_records_from_file $pf] + #get_installer_record errors on duplicates - catch result 0 + found position proves exactly one + set dup_or_missing [list] + foreach name {WRA WRB} { + if {[catch {punkcheck::recordlist::get_installer_record $name $records} info]} { + lappend dup_or_missing "$name: $info" + } elseif {[dict get $info position] == -1} { + lappend dup_or_missing "$name: missing" + } + } + set missing_targets [list] + foreach name {WRA WRB} { + for {set ev 0} {$ev < 3} {incr ev} { + foreach t {a b} { + set target ${name}_${ev}_${t}.txt + if {[dict get [punkcheck::recordlist::get_file_record $target $records] position] == -1} { + lappend missing_targets $target + } + } + } + } + set leftovers [glob -nocomplain -tails -dir $root .punkcheck.lock .punkcheck.tmp.*] + list parse_errors [llength $parse_errors] reader_ran [expr {$observed_loads > 0}] installer_problems $dup_or_missing missing_targets $missing_targets leftovers $leftovers + }\ + -cleanup { + file delete -force [dict get $ws root] + }\ + -result {parse_errors 0 reader_ran 1 installer_problems {} missing_targets {} leftovers {}} + + # ========================================================================= + # --- lock contention: waiting and timeout naming the holder --- + # ========================================================================= + + test concurrency_lock_timeout_names_holder {second writer times out with a message naming the holder from lockfile contents, then succeeds after release}\ + -constraints canexecchild\ + -body { + set ws [make_workspace] + set root [dict get $ws root] + set pf [dict get $ws punkcheck_file] + set holder [file join $root holder.tcl] + set script [child_preamble] + append script { + lassign $argv pf root + set tok [punkcheck::lock::acquire $pf -installer HOLDER-CHILD] + set fd [open $root/held w]; close $fd + after 2500 + punkcheck::lock::release $tok + set fd [open $root/released w]; close $fd + } + write_file $holder $script + exec [info nameofexecutable] $holder $pf $root > $root/holder.log 2>@1 & + poll_until {expr {[file exists $root/held]}} 30000 "holder child to acquire the lock" + #contended attempt with a short timeout - must error naming the holder + set errcaught [catch {punkcheck::lock::acquire $pf -installer IMPATIENT -timeout 400} errmsg erropts] + set code_ok [expr {[lrange [dict get $erropts -errorcode] 0 2] eq [list PUNKCHECK LOCK TIMEOUT]}] + poll_until {expr {[file exists $root/released]}} 30000 "holder child to release the lock" + #after release the same acquisition succeeds (the waiting side of the contract) + set tok [punkcheck::lock::acquire $pf -installer IMPATIENT -timeout 5000] + punkcheck::lock::release $tok + list errcaught $errcaught code_ok $code_ok names_holder [string match "*held by:*HOLDER-CHILD*" $errmsg] lock_cleared [expr {![file exists $pf.lock]}] + }\ + -cleanup { + file delete -force [dict get $ws root] + }\ + -result {errcaught 1 code_ok 1 names_holder 1 lock_cleared 1} + + # ========================================================================= + # --- stale-lock breaking: dead holder pid, and age --- + # ========================================================================= + + test concurrency_stale_break_dead_pid {planted lockfile from a provably-dead pid on this host is broken immediately with a warning}\ + -constraints {canexecchild haspidliveness}\ + -body { + set ws [make_workspace] + set root [dict get $ws root] + set pf [dict get $ws punkcheck_file] + #obtain a genuinely dead pid: a child that just printed its pid and exited + set pidscript [write_file [file join $root printpid.tcl] {puts [pid]}] + set deadpid [string trim [exec [info nameofexecutable] $pidscript]] + #plant a FRESH lockfile naming the dead pid - only liveness (not age) can explain a break + write_file $pf.lock [dict create pid $deadpid host [info hostname] installer GHOST tsiso [clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"] ts [clock microseconds]] + set warnlog [file join $root warn.log] + set wchan [open $warnlog w] + set tok [punkcheck::lock::acquire $pf -installer BREAKER -timeout 3000 -warnchannel $wchan] + close $wchan + set warning [punk::mix::util::fcat $warnlog] + punkcheck::lock::release $tok + list acquired 1 warned_dead [string match "*no longer running*" $warning] names_ghost [string match "*GHOST*" $warning] lock_cleared [expr {![file exists $pf.lock]}] + }\ + -cleanup { + file delete -force [dict get $ws root] + }\ + -result {acquired 1 warned_dead 1 names_ghost 1 lock_cleared 1} + + test concurrency_stale_break_age {planted old lockfile from another host is broken on age with a warning}\ + -body { + set ws [make_workspace] + set root [dict get $ws root] + set pf [dict get $ws punkcheck_file] + #host mismatch keeps the liveness probe out of it - age alone must explain the break + write_file $pf.lock [dict create pid 99999999 host not-this-host-[pid] installer GHOST tsiso 2026-01-01T00:00:00 ts 0] + file mtime $pf.lock [expr {[clock seconds] - 3600}] + set warnlog [file join $root warn.log] + set wchan [open $warnlog w] + set tok [punkcheck::lock::acquire $pf -installer BREAKER -timeout 3000 -staleage 5 -warnchannel $wchan] + close $wchan + set warning [punk::mix::util::fcat $warnlog] + punkcheck::lock::release $tok + list acquired 1 warned_age [string match "*older than 5s*" $warning] lock_cleared [expr {![file exists $pf.lock]}] + }\ + -cleanup { + file delete -force [dict get $ws root] + }\ + -result {acquired 1 warned_age 1 lock_cleared 1} + + # ========================================================================= + # --- duplicate-INSTALLER sanity: clean error when stdin is non-interactive --- + # ========================================================================= + + test concurrency_dup_installer_noninteractive_error {duplicate INSTALLER records raise a clean actionable error in a non-interactive child (no prompt, no hang)}\ + -constraints canexecchild\ + -body { + set ws [make_workspace] + set root [dict get $ws root] + set pf [dict get $ws punkcheck_file] + #craft a .punkcheck with two INSTALLER records sharing one name + set r1 [punkcheck::recordlist::new_installer_record dupname] + set r2 [punkcheck::recordlist::new_installer_record dupname] + punkcheck::save_records_to_file [list $r1 $r2] $pf "test dup plant" + set probe [file join $root dupprobe.tcl] + set script [child_preamble] + append script { + lassign $argv pf + if {[catch {punkcheck::installtrack new dupname $pf} err]} { + puts "ERR: $err" + } else { + puts "NOERROR" + } + exit 0 + } + write_file $probe $script + #r+ pipe: the child's stdin is a pipe, so the non-interactive path must engage + set chan [open |[list [info nameofexecutable] $probe $pf] r+] + set outlines [list] + set deadline [expr {[clock milliseconds] + 30000}] + chan configure $chan -blocking 0 + while {![chan eof $chan]} { + if {[clock milliseconds] >= $deadline} { + catch {close $chan} + error "timeout: dup-installer child did not complete (prompt hang?)" + } + set line [gets $chan] + if {$line ne ""} { + lappend outlines $line + } + after 20 + } + catch {close $chan} + set out [join $outlines \n] + list errored [string match "ERR:*" $out] mentions_dup [string match "*multiple INSTALLER records*" $out] noninteractive [string match "*non-interactive*" $out] actionable [string match "*Recovery:*" $out] + }\ + -cleanup { + file delete -force [dict get $ws root] + }\ + -result {errored 1 mentions_dup 1 noninteractive 1 actionable 1} + + # ========================================================================= + # --- protocol siblings are excluded from install content --- + # ========================================================================= + + test concurrency_protocol_files_not_installed {a .punkcheck.lock in the source tree is not copied by punkcheck::install (default core exclusions)}\ + -body { + set ws [make_workspace] + write_file [file join [dict get $ws srcdir] keep.txt] "k" + write_file [file join [dict get $ws srcdir] .punkcheck.lock] "planted" + write_file [file join [dict get $ws srcdir] .punkcheck.tmp.1234] "planted" + punkcheck::install [dict get $ws srcdir] [dict get $ws tgtdir] -overwrite all-targets + list copied_lock [file exists [file join [dict get $ws tgtdir] .punkcheck.lock.copiedcheck]] lock_at_tgt [file exists [file join [dict get $ws tgtdir] .punkcheck.lock]] tmp_at_tgt [file exists [file join [dict get $ws tgtdir] .punkcheck.tmp.1234]] keep_at_tgt [file exists [file join [dict get $ws tgtdir] keep.txt]] + }\ + -cleanup { + file delete -force [dict get $ws root] + }\ + -result {copied_lock 0 lock_at_tgt 0 tmp_at_tgt 0 keep_at_tgt 1} +} +tcltest::cleanupTests ;#needed to produce test summary line.