Browse Source
The final G-126 acceptance clauses:
- punk::zip::accelerator (auto|none|<path>): auto probes
env(PUNKZIP_EXE) then a punkzip beside [info nameofexecutable];
resolution cached until reconfigured
- unzip hands whole-archive member WRITING to the accelerator only when
the call is one it serves identically (globs {*}, no excludes,
default -overwrite/-mtime/-verify, ascii member names) and re-stamps
mtimes with punk::zip's local-time convention afterwards, so the two
engines produce identical trees; preflight refusals, member selection
and the returned names always come from punk::zip's own reader (the
G-124 floor, unchanged); accelerator failure falls back to pure Tcl
silently; last_unzip_engine/last_accelerator_note expose the per-call
decision
- parity suite zipaccel.test (9 tests): identical names, bytes and
mtimes through both engines over the G-124 shapes and whole-kit
extraction of the file-relative tclsh90b4_piperepl.exe (841 members);
listings engine-independent; punkzip porcelain agrees with punk::zip
member dicts on every shared field (mtime excluded by design - UTC vs
local convention); pure path proven when the binary is absent;
selective calls proven to run pure. Implicit directories (kits store
no dir entries) are excluded from mtime comparison - neither engine
stamps them
- recorded benchmark (in the goal detail): accelerator fixed cost
~9-13ms, crossover ~15-20 members, material (>= x1.7) from ~50;
x2.3-2.6 at kit scale under a native tclsh and x3.8-4.9 kit-hosted
(punk91.exe 21.9s -> 5.7s) - the bake-from-kit case the goal
motivated
- full runtests at recorded baseline under tclsh9.0.5-punk: 1186/1211,
1 failed = the pre-existing exec-14.3 baseline
Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
6 changed files with 500 additions and 18 deletions
@ -1,4 +1,4 @@
|
||||
[project] |
||||
name = "punkshell" |
||||
version = "0.28.3" |
||||
version = "0.28.4" |
||||
license = "BSD-2-Clause" |
||||
|
||||
@ -0,0 +1,271 @@
|
||||
package require tcltest |
||||
|
||||
package require punk::zip |
||||
|
||||
#added 2026-07-27 (agent, G-126) - parity suite for the punkzip extraction accelerator. |
||||
#Proves the accelerated and pure-Tcl unzip paths produce IDENTICAL results (member name |
||||
#lists, byte-identical extraction trees, matching file AND directory mtimes) over the |
||||
#G-124 fixture shapes (plain / archive-relative prefixed / file-relative prefixed, one |
||||
#source tree), that listings are engine-independent, that punkzip's porcelain listing |
||||
#agrees with punk::zip's member dicts on every shared field, that the pure-Tcl path is |
||||
#taken when the accelerator binary is absent, and that calls the accelerator cannot |
||||
#serve identically (selective globs) silently run pure-Tcl. |
||||
#The accelerator-dependent tests self-gate on bin/punkzip existing ('make.tcl tool |
||||
#build punkzip' builds it); the pure-path-when-absent proof runs everywhere. |
||||
#mtime NOTE: porcelain mtimes are punkzip's tz-free UTC interpretation of the DOS |
||||
#fields while punk::zip's member mtimes use the local-time convention, so the |
||||
#porcelain crosscheck compares every shared field EXCEPT mtime (recorded in the |
||||
#G-126 goal notes); extraction-tree mtimes ARE compared - the accelerated path |
||||
#re-stamps them with punk::zip's convention, so the engines must agree exactly. |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
|
||||
variable BASE [makeDirectory g126_zipaccel] |
||||
|
||||
variable projectroot [file normalize [file join [file dirname [info script]] .. .. .. .. .. .. ..]] |
||||
variable ACCEL "" |
||||
foreach _cand [list [file join $projectroot bin punkzip.exe] [file join $projectroot bin punkzip]] { |
||||
if {[file isfile $_cand]} { |
||||
set ACCEL $_cand |
||||
break |
||||
} |
||||
} |
||||
testConstraint punkzipavailable [expr {$ACCEL ne ""}] |
||||
|
||||
#the recorded file-relative runtime named in the G-126 Acceptance (same pin as |
||||
#zipreader.test). Not in the repo (bin/ build outputs are untracked) so it self-gates. |
||||
variable PIPEREPL [file join $projectroot bin runtime win32-x86_64 tclsh90b4_piperepl.exe] |
||||
testConstraint piperepl_runtime [file exists $PIPEREPL] |
||||
|
||||
proc fwrite {path content} { |
||||
file mkdir [file dirname $path] |
||||
set fd [open $path wb] |
||||
puts -nonewline $fd $content |
||||
close $fd |
||||
} |
||||
proc fread {path} { |
||||
set fd [open $path rb] |
||||
set data [read $fd] |
||||
close $fd |
||||
return $data |
||||
} |
||||
|
||||
#paths whose mtimes the engines actually STAMP: members with a representable |
||||
#stored time. Anything else (implicit intermediate directories - e.g. the |
||||
#piperepl kit stores no directory entries at all - or zero-mtime members) gets |
||||
#extraction wall-time from either engine, which legitimately differs between |
||||
#two runs and must not be compared. |
||||
proc stampset {archive} { |
||||
set s [dict create] |
||||
foreach m [punk::zip::members $archive] { |
||||
if {[dict get $m mtime]} { |
||||
dict set s [string trimright [dict get $m name] /] 1 |
||||
} |
||||
} |
||||
return $s |
||||
} |
||||
#recursive snapshot: relpath -> dir/file record incl. content crc and mtime |
||||
#(mtime recorded as 'unstamped' for paths outside the stamped set) |
||||
proc treesnap {base stamped {rel ""}} { |
||||
set snap [dict create] |
||||
set dir [expr {$rel eq "" ? $base : [file join $base $rel]}] |
||||
foreach p [lsort [glob -nocomplain -dir $dir *]] { |
||||
set name [file tail $p] |
||||
set r [expr {$rel eq "" ? $name : "$rel/$name"}] |
||||
set mt [expr {[dict exists $stamped $r] ? [file mtime $p] : "unstamped"}] |
||||
if {[file isdirectory $p]} { |
||||
dict set snap $r [list dir mtime $mt] |
||||
set snap [dict merge $snap [treesnap $base $stamped $r]] |
||||
} else { |
||||
dict set snap $r [list file size [file size $p] crc [format %08x [zlib crc32 [fread $p]]] mtime $mt] |
||||
} |
||||
} |
||||
return $snap |
||||
} |
||||
#empty string when identical; otherwise names the first difference |
||||
proc snapdiff {a b} { |
||||
set ka [lsort [dict keys $a]] |
||||
set kb [lsort [dict keys $b]] |
||||
if {$ka ne $kb} { |
||||
set onlya [list] |
||||
set onlyb [list] |
||||
foreach k $ka {if {![dict exists $b $k]} {lappend onlya $k}} |
||||
foreach k $kb {if {![dict exists $a $k]} {lappend onlyb $k}} |
||||
return "keysets differ - only-first:$onlya only-second:$onlyb" |
||||
} |
||||
dict for {k v} $a { |
||||
if {$v ne [dict get $b $k]} { |
||||
return "entry '$k' differs: $v vs [dict get $b $k]" |
||||
} |
||||
} |
||||
return "" |
||||
} |
||||
|
||||
# -- --- --- fixtures: the G-124 shapes (one source tree, packed three ways) --- --- -- |
||||
variable SRC [file join $BASE srctree] |
||||
variable PREAMBLE [file join $BASE preamble.bin] |
||||
variable PLAIN [file join $BASE plain.zip] |
||||
variable ARCREL [file join $BASE arcrel.bin] |
||||
variable FILEREL [file join $BASE filerel.bin] |
||||
|
||||
file delete -force $SRC |
||||
file mkdir $SRC/sub/deeper |
||||
fwrite $SRC/hello.txt "hello world\n" |
||||
fwrite $SRC/sub/nested.tcl "puts nested\n" |
||||
set fixturebytes "" |
||||
for {set i 0} {$i < 256} {incr i} { |
||||
append fixturebytes [binary format c $i] |
||||
} |
||||
fwrite $SRC/binary.dat $fixturebytes |
||||
set BIGTEXT "" |
||||
for {set i 0} {$i < 40000} {incr i} { |
||||
append BIGTEXT "line $i of a member large enough to force the streaming path\n" |
||||
} |
||||
fwrite $SRC/sub/deeper/big.txt $BIGTEXT |
||||
fwrite $PREAMBLE [string repeat "PREAMBLE-BYTES-\x00\x01\x02\x50\x4b\x05\x06" 4096] |
||||
punk::zip::mkzip -return none -directory $SRC -- $PLAIN * |
||||
punk::zip::mkzip -return none -offsettype archive -runtime $PREAMBLE -directory $SRC -- $ARCREL * |
||||
punk::zip::mkzip -return none -offsettype file -runtime $PREAMBLE -directory $SRC -- $FILEREL * |
||||
|
||||
#run one extraction under an explicit accelerator configuration; returns a dict |
||||
#with the extracted names, the engine that ran, the fallback note and a snapshot |
||||
proc extract_with {config archive outdir args} { |
||||
variable BASE |
||||
set target [file join $BASE $outdir] |
||||
file delete -force $target |
||||
punk::zip::accelerator $config |
||||
set names [punk::zip::unzip $archive $target {*}$args] |
||||
set r [dict create\ |
||||
names [lsort $names]\ |
||||
engine $::punk::zip::last_unzip_engine\ |
||||
note $::punk::zip::last_accelerator_note\ |
||||
snap [treesnap $target [stampset $archive]]\ |
||||
] |
||||
punk::zip::accelerator auto |
||||
return $r |
||||
} |
||||
|
||||
# -- --- --- accelerator resolution --- --- -- |
||||
|
||||
test zipaccel_resolves_explicit_path {an explicit accelerator path resolves and none disables} -constraints {punkzipavailable} -body { |
||||
variable ACCEL |
||||
set result [list] |
||||
lappend result explicit [expr {[punk::zip::accelerator $ACCEL] ne ""}] |
||||
lappend result none [punk::zip::accelerator none] |
||||
punk::zip::accelerator auto |
||||
set result |
||||
} -result {explicit 1 none {}} |
||||
|
||||
test zipaccel_pure_path_when_absent {a missing accelerator binary resolves empty and unzip runs pure-Tcl successfully} -body { |
||||
variable PLAIN |
||||
set r [extract_with [file join $::testspace::BASE nosuch punkzip.exe] $PLAIN out_absent] |
||||
list resolved_empty [expr {$::punk::zip::accelerator_resolved eq ""}]\ |
||||
engine [dict get $r engine]\ |
||||
extracted_count [llength [dict get $r names]]\ |
||||
note_names_it [string match "*no accelerator binary resolved*" [dict get $r note]] |
||||
} -result {resolved_empty 1 engine tcl extracted_count 6 note_names_it 1} |
||||
|
||||
# -- --- --- listings are engine-independent --- --- -- |
||||
|
||||
test zipaccel_listing_engine_independent {members and archive_info return identical results whatever the accelerator configuration} -constraints {punkzipavailable} -body { |
||||
variable PLAIN |
||||
variable ACCEL |
||||
punk::zip::accelerator none |
||||
set m1 [punk::zip::members $PLAIN] |
||||
set i1 [punk::zip::archive_info $PLAIN] |
||||
punk::zip::accelerator $ACCEL |
||||
set m2 [punk::zip::members $PLAIN] |
||||
set i2 [punk::zip::archive_info $PLAIN] |
||||
punk::zip::accelerator auto |
||||
list members_equal [expr {$m1 eq $m2}] info_equal [expr {$i1 eq $i2}] |
||||
} -result {members_equal 1 info_equal 1} |
||||
|
||||
# -- --- --- porcelain crosscheck: two independent readers agree --- --- -- |
||||
|
||||
test zipaccel_porcelain_crosscheck {punkzip's porcelain listing agrees with punk::zip's member dicts on every shared field} -constraints {punkzipavailable} -body { |
||||
variable PLAIN |
||||
variable ACCEL |
||||
set out [exec $ACCEL list -porcelain $PLAIN 2>@1] |
||||
set porc [dict create] |
||||
set sawversion 0 |
||||
foreach line [split $out \n] { |
||||
set line [string trimright $line \r] |
||||
if {$line eq "" || [string range $line 0 1] eq "# "} {continue} |
||||
if {!$sawversion} { |
||||
if {$line eq "punkzip_porcelain_v1"} {set sawversion 1} |
||||
continue |
||||
} |
||||
if {[regexp {^m (\d) (\S+) (\d+) (\d+) ([0-9a-f]{8}) (-?\d+) (\d) (\d+) (\d+) (.*)$} $line -> isdir methodname uncomp comp crc mtime enc madeby namelen name]} { |
||||
dict set porc $name [dict create isdir $isdir methodname $methodname size $uncomp csize $comp crc $crc encrypted $enc madeby $madeby namelen $namelen] |
||||
} |
||||
} |
||||
set result [list sawversion $sawversion] |
||||
set members [punk::zip::members $PLAIN] |
||||
lappend result member_count_equal [expr {[dict size $porc] == [llength $members]}] |
||||
set mismatches [list] |
||||
foreach m $members { |
||||
set name [dict get $m name] |
||||
if {![dict exists $porc $name]} { |
||||
lappend mismatches "missing-from-porcelain:$name" |
||||
continue |
||||
} |
||||
set p [dict get $porc $name] |
||||
foreach {pkey mkey conv} {isdir isdirectory {} methodname methodname {} size size {} csize csize {} encrypted encrypted {} madeby madeby {}} { |
||||
set mv [dict get $m $mkey] |
||||
if {[dict get $p $pkey] ne $mv} { |
||||
lappend mismatches "$name:$pkey=[dict get $p $pkey]!=$mv" |
||||
} |
||||
} |
||||
if {[dict get $p crc] ne [format %08x [dict get $m crc]]} { |
||||
lappend mismatches "$name:crc" |
||||
} |
||||
if {[dict get $p namelen] != [string length $name]} { |
||||
lappend mismatches "$name:namelen" |
||||
} |
||||
} |
||||
lappend result mismatches $mismatches |
||||
set result |
||||
} -result {sawversion 1 member_count_equal 1 mismatches {}} |
||||
|
||||
# -- --- --- extraction parity over the three shapes --- --- -- |
||||
|
||||
foreach {shapename shapevar} {plain PLAIN archiverelative ARCREL filerelative FILEREL} { |
||||
test zipaccel_unzip_parity_$shapename "accelerated and pure-Tcl extraction of the $shapename shape produce identical names, bytes and mtimes" -constraints {punkzipavailable} -body [string map [list %V% $shapevar] { |
||||
variable %V% |
||||
variable ACCEL |
||||
set pure [extract_with none [set %V%] out_pure] |
||||
set fast [extract_with $ACCEL [set %V%] out_fast] |
||||
list engines [list [dict get $pure engine] [dict get $fast engine]]\ |
||||
names_equal [expr {[dict get $pure names] eq [dict get $fast names]}]\ |
||||
treediff [snapdiff [dict get $pure snap] [dict get $fast snap]] |
||||
}] -result {engines {tcl accelerated} names_equal 1 treediff {}} |
||||
} |
||||
|
||||
# -- --- --- per-call decision: ineligible calls silently run pure --- --- -- |
||||
|
||||
test zipaccel_selective_call_runs_pure {a selective (glob) extraction is not accelerator-eligible and silently runs pure-Tcl} -constraints {punkzipavailable} -body { |
||||
variable PLAIN |
||||
variable ACCEL |
||||
set r [extract_with $ACCEL $PLAIN out_selective sub/*] |
||||
list engine [dict get $r engine]\ |
||||
names [dict get $r names]\ |
||||
note_names_it [string match "*not accelerator-eligible*" [dict get $r note]] |
||||
} -result {engine tcl names {sub/ sub/deeper/ sub/deeper/big.txt sub/nested.tcl} note_names_it 1} |
||||
|
||||
# -- --- --- the real file-relative prefixed executable --- --- -- |
||||
|
||||
test zipaccel_piperepl_parity {whole-kit extraction of the recorded file-relative runtime is identical through both engines} -constraints {punkzipavailable piperepl_runtime} -body { |
||||
variable PIPEREPL |
||||
variable ACCEL |
||||
set pure [extract_with none $PIPEREPL out_rt_pure] |
||||
set fast [extract_with $ACCEL $PIPEREPL out_rt_fast] |
||||
list engines [list [dict get $pure engine] [dict get $fast engine]]\ |
||||
member_count [llength [dict get $pure names]]\ |
||||
names_equal [expr {[dict get $pure names] eq [dict get $fast names]}]\ |
||||
treediff [snapdiff [dict get $pure snap] [dict get $fast snap]] |
||||
} -result {engines {tcl accelerated} member_count 841 names_equal 1 treediff {}} |
||||
|
||||
cleanupTests |
||||
} |
||||
namespace delete ::testspace |
||||
Loading…
Reference in new issue