From 43adc8303556c870d0b81005362a675cabf46054 Mon Sep 17 00:00:00 2001 From: Chad Granum Date: Sat, 25 Apr 2026 11:29:13 -0700 Subject: [PATCH 01/13] Add Test2::Harness2::Resource::PipeLimits stub Stub resource class for throttling test launches against the user's soft pipe-count limit. Spec from feedback: * Throttle new assignments when (soft_limit - in_use) <= headroom. * Emit a one-shot user-facing warning the first time usage crosses warn_threshold * soft_limit; never warn again for the lifetime of this resource instance, even if usage briefly drops and climbs. Why a separate resource from UnixLimits: Per-process pipe count is not directly an rlimit on most platforms. Linux exposes it via /proc/sys/fs/pipe-user-pages-{soft,hard} (system-wide, not rlimit-style); the BSDs / macOS impose it indirectly via RLIMIT_NOFILE plus per-pipe FD cost. The harness opens many pipes per concurrent test (collector stdout/stderr capture, EventEmitter sync, IPC client socketpairs, ...) and a pipe-count cap can fire well before RLIMIT_NOFILE does. Tracking pipes specifically deserves its own sampler. Stub mirrors the shape of Resource/UnixLimits.pm: HashBase fields for headroom / warn_threshold / poll_interval, a sticky _warned flag for the one-shot guarantee, available/assign/release croak "not implemented yet", status() returns the configured knobs plus the warned flag for monitoring. Co-Authored-By: Claude Opus 4.7 (1M context) --- lib/Test2/Harness2/Resource/PipeLimits.pm | 219 ++++++++++++++++++++++ 1 file changed, 219 insertions(+) create mode 100644 lib/Test2/Harness2/Resource/PipeLimits.pm diff --git a/lib/Test2/Harness2/Resource/PipeLimits.pm b/lib/Test2/Harness2/Resource/PipeLimits.pm new file mode 100644 index 000000000..d2de83b39 --- /dev/null +++ b/lib/Test2/Harness2/Resource/PipeLimits.pm @@ -0,0 +1,219 @@ +package Test2::Harness2::Resource::PipeLimits; +use strict; +use warnings; + +our $VERSION = '2.000011'; + +use Carp qw/croak/; + +use Object::HashBase qw{ + {+HEADROOM} //= 32; + + # Fraction of the soft limit at which the user-facing one-shot + # warning fires. Crosses once: if usage drops back below and + # later climbs back, the warning does NOT re-fire (per spec: + # "warn only once"). + $self->{+WARN_THRESHOLD} //= 0.85; + + $self->{+POLL_INTERVAL} //= 2; + + # Sticky one-shot flag for the warning. Initialised to 0; flipped + # to 1 the first time live usage crosses warn_threshold * limit. + # Survives subsequent samples; the resource never warns again + # for the lifetime of this object. + $self->{+_WARNED} //= 0; +} + +# STUB: throttles new test launches when the user is close to their +# soft pipe-count limit, and emits a one-shot warning so the user +# knows to raise the limit (or kill whatever is hoarding pipes) +# before the throttle bites further runs. +# +# Why a separate resource from UnixLimits: +# Per-process pipe count is not directly an rlimit on most platforms. +# Linux exposes it via /proc/sys/fs/pipe-user-pages-{soft,hard} +# (system-wide, not rlimit-style); macOS / BSD impose it indirectly +# via RLIMIT_NOFILE and per-pipe file-descriptor cost. Tracking pipe +# count specifically -- not just open FDs -- needs its own sampler +# because the harness opens a *lot* of pipes per concurrent test +# (collector stdout/stderr capture, EventEmitter sync, IPC client +# socketpairs, ...) and a pipe-count cap can fire well before +# RLIMIT_NOFILE does. +# +# Scope: +# - Unix-family platforms only (Linux, the BSD variants, macOS, +# Solaris / illumos). Windows is out of scope -- the pipe-allocation +# accounting differs enough that it is a separate problem. +# +# Sampling sources by platform (suggested platform-specific +# subclasses, mirroring the UnixLimits.pm split): +# +# - Linux: +# - Soft cap: read /proc/sys/fs/pipe-user-pages-soft. +# - Live usage: walk /proc//fd looking for "pipe:..." +# symlinks; or aggregate /proc//fdinfo for kind=pipe. +# cgroup v2 io.max may layer on top in modern systemd user +# sessions -- worth respecting when present. +# - BSD (FreeBSD / OpenBSD / NetBSD / DragonFly): +# - Soft cap: sysctl kern.ipc.maxpipekva (system-wide page budget, +# not strictly per-user, but the closest analog). +# - Live usage: kinfo_getfile / libprocstat for per-process pipe +# FDs; then sum across our managed pid tree. +# - macOS (Darwin): proc_pidinfo + PROC_PIDLISTFDS, filter for +# PROX_FDTYPE_PIPE. +# - Solaris / illumos: prctl(2) doesn't expose a pipe rlimit per se; +# fall back to RLIMIT_NOFILE accounting plus /proc//fd kind +# filtering, and treat the soft cap as +# min(RLIMIT_NOFILE, sysconf(_SC_OPEN_MAX)). +# +# Intended implementation shape: +# 1. A `service_pipe_limits_monitor` child runs in the background +# polling every poll_interval seconds for (soft_limit, in_use). +# The monitor IPCs the latest sample to this resource. +# 2. available(%p) computes +# free = soft_limit - in_use - headroom +# and returns 0 when free < the job's pipe-cost estimate +# (typically 4-6 pipes per concurrent test: 2 for the collector +# stdout/stderr capture pair, 1-2 for EventEmitter sync, 1-2 for +# IPC client socketpairs). When 0, log throttling once per +# transition into "throttled" -- not every poll. +# 3. assign / release track per-assignment estimates against +# in_use_in_flight; the next monitor sample is authoritative. +# 4. After each sample the resource checks +# in_use >= warn_threshold * soft_limit +# If that's true and _WARNED is 0, emit a single warning event +# naming the soft limit, current usage, and the suggested action +# (raise pipe-user-pages-soft on Linux, etc.). Set _WARNED = 1 +# so the warning never re-fires for this resource instance. +# The warning goes out via emit_resource_warning (analogous to +# the existing diag/warn pattern in Disk / Memory) so the +# renderer can surface it once at the user. +# 5. teardown() is a no-op beyond stopping the monitor service. +sub available { croak __PACKAGE__ . "::available is not implemented yet" } +sub assign { croak __PACKAGE__ . "::assign is not implemented yet" } +sub release { croak __PACKAGE__ . "::release is not implemented yet" } + +sub status { + my $self = shift; + return { + resource => $self->resource_name, + headroom => $self->{+HEADROOM}, + warn_threshold => $self->{+WARN_THRESHOLD}, + poll_interval => $self->{+POLL_INTERVAL}, + warned => $self->{+_WARNED}, + broken => $self->is_broken, + paused => $self->is_paused, + permanent => $self->is_permanent_broken, + assignments => [], + }; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Harness2::Resource::PipeLimits - (STUB) Throttle jobs and warn once when close to the user's soft pipe limit. + +=head1 STATUS + +Stub only. Placeholder for a resource that: + +=over 4 + +=item * + +Throttles new job launches (C returns 0) when the user's +soft pipe-count limit minus current usage drops below C. + +=item * + +Emits exactly one user-facing warning the first time usage crosses +C, advising the user to raise the +limit or release pipes before the throttle bites. The warning is +sticky -- it never re-fires for the lifetime of this resource +instance, even if usage briefly drops and climbs again. + +=back + +Intended to support Linux, the BSD variants (FreeBSD / OpenBSD / +NetBSD / DragonFly / macOS), and Solaris / illumos. Each platform's +sampler is a candidate for a dedicated subclass (e.g. +L, +L, +L) that plugs into +this base class's scheduling contract. + +Windows and other non-Unix platforms are explicitly out of scope +for this resource; pipe-allocation accounting on Win32 is +sufficiently different that it deserves its own implementation +rather than a shoehorned subclass here. + +=head1 ATTRIBUTES + +=over 4 + +=item headroom + +Pipes to leave free under the soft limit. C returns 0 +when C. Default: C<32>. + +=item warn_threshold + +Fraction of the soft limit at which the one-shot warning fires. +Default: C<0.85> (warn at 85% usage). + +=item poll_interval + +Seconds between samples of (soft_limit, in_use). Default: C<2>. + +=back + +=head1 SEE ALSO + +L -- sibling stub for +RLIMIT_NPROC / RLIMIT_NOFILE throttling. PipeLimits exists separately +because per-process pipe count is not exposed as an rlimit on most +platforms and needs its own platform-specific sampler. + +=head1 SOURCE + +L + +=head1 AUTHORS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 COPYRIGHT + +Copyright Chad Granum Eexodist7@gmail.comE. + +See L + +=cut From f76a8f515ce396033181fb394be1a86bccb5a7f4 Mon Sep 17 00:00:00 2001 From: Andy Baugh Date: Sun, 26 Apr 2026 06:49:22 -0500 Subject: [PATCH 02/13] replay.t: replace live-vs-replay comparison with committed golden Instead of running yath test live, capturing non-deterministic output, and sorting job lines to paper over ordering differences, commit a pre-generated run.yath archive and an expected_output.txt golden file. The test now replays only the committed archive. Replay is deterministic (events come out in archive order), so no sorting normalization is needed. The clean_output helper gains absolute-path stripping so the golden file is portable across machines. Co-Authored-By: Claude Sonnet 4.6 --- t/Yath/integration/replay.t | 66 +++++------------- t/Yath/integration/replay/expected_output.txt | 17 +++++ t/Yath/integration/replay/run.yath | Bin 0 -> 25120 bytes 3 files changed, 36 insertions(+), 47 deletions(-) create mode 100644 t/Yath/integration/replay/expected_output.txt create mode 100644 t/Yath/integration/replay/run.yath diff --git a/t/Yath/integration/replay.t b/t/Yath/integration/replay.t index 0865a841b..bd3e972e8 100644 --- a/t/Yath/integration/replay.t +++ b/t/Yath/integration/replay.t @@ -2,13 +2,10 @@ # HARNESS-DURATION-SLOW use Test2::V0; -use File::Temp qw/tempdir/; use File::Spec; use lib 't/lib'; use Test2::Harness2::Test::Yath qw/yath/; -use Test2::Harness2::Util::File::JSONL; -use Test2::Harness2::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; @@ -16,6 +13,7 @@ $dir =~ s{^\./}{}; sub clean_output { my $out = shift; + $out->{output} =~ s/^.*duration.*$//m; $out->{output} =~ s/^.*Wrote log file:.*$//m; $out->{output} =~ s/^.*Wrote archive:.*$//m; @@ -34,10 +32,13 @@ sub clean_output { $out->{output} =~ s/^FIXME: publish should send log to server$//gm; # Normalize display job numbers: parallel jobs complete in non-deterministic - # order so the renderer assigns job 1/2/... differently each run. Replace - # all "job N" sequences with "job N" sentinel so both sides match. + # order so the renderer assigns job 1/2/... differently each run. $out->{output} =~ s/\bjob\s+\d+\b/job N/g; + # Normalize absolute paths in "at /abs/path/t/... line N" diagnostics + # to repo-relative so the golden file is portable across machines. + $out->{output} =~ s{ at \S+/(t/\S+) line }{ at $1 line }g; + my @lines; my $start; for my $line (split /\n/, $out->{output}) { @@ -48,54 +49,25 @@ sub clean_output { push @lines => $line; } - # Sort consecutive PASSED/FAILED job-status lines so that parallel - # completion order does not break the comparison. - my @normalized; - my @status_group; - for my $line (@lines) { - if ($line =~ /^\(\s*(?:PASSED|FAILED)\s*\)/) { - push @status_group => $line; - } - else { - if (@status_group) { - push @normalized => sort @status_group; - @status_group = (); - } - push @normalized => $line; - } - } - push @normalized => sort @status_group if @status_group; - - $out->{output} = join "\n" => @normalized; + $out->{output} = join "\n" => @lines; } -my $out1 = yath( - command => 'test', - args => [$dir, '--ext=tx'], - log => 1, - exit => T(), - test => sub { - my $out = shift; - clean_output($out); - - like($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the log"); - like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the log"); - - }, -); +my $archive = File::Spec->catfile($dir, 'run.yath'); +my $golden = File::Spec->catfile($dir, 'expected_output.txt'); -my $logfile = $out1->{log}->name; +open(my $fh, '<', $golden) or die "Cannot read golden file '$golden': $!"; +my $expected = do { local $/; <$fh> }; +close($fh); +chomp $expected; yath( command => 'replay', - args => [$logfile], - exit => $out1->{exit}, - test => sub { - my $out2 = shift; - clean_output($out2); - clean_output($out1); - - is($out2->{output}, $out1->{output}, "Replay has identical output to original"); + args => [$archive], + exit => T(), + test => sub { + my $out = shift; + clean_output($out); + is($out->{output}, $expected, "Replay output matches committed golden"); }, ); diff --git a/t/Yath/integration/replay/expected_output.txt b/t/Yath/integration/replay/expected_output.txt new file mode 100644 index 000000000..ce6d16898 --- /dev/null +++ b/t/Yath/integration/replay/expected_output.txt @@ -0,0 +1,17 @@ +( FAILED ) job N t/Yath/integration/replay/fail.tx +( PASSED ) job N t/Yath/integration/replay/pass.tx +[ FAIL ] job N + Fail +( DIAG ) job N Failed test 'Fail' +( DIAG ) job N at t/Yath/integration/replay/fail.tx line 3. +< REASON > job N Test script returned error (Err: 1) +< REASON > job N Assertion failures were encountered (Count: 1) +The following jobs failed: ++--------------------------------------+-----------------------------------+ +| Job ID | Test File | ++--------------------------------------+-----------------------------------+ +| 019DC98E-B2C3-7025-A50A-0717DEFCC238 | t/Yath/integration/replay/fail.tx | ++--------------------------------------+-----------------------------------+ +Yath Result Summary +Fail Count: 1 +File Count: 2 +--> Result: FAILED <-- diff --git a/t/Yath/integration/replay/run.yath b/t/Yath/integration/replay/run.yath new file mode 100644 index 0000000000000000000000000000000000000000..849f83759108f1340cb97fa87f233848ff6340a4 GIT binary patch literal 25120 zcmeIaby!?owkCc`fWjq6;e|u6D%?}JySqCfc!DIjy95mc2pS~8Nq_`*4X(i*k^lkX z!+NIhb@NL9 z#$W%TQ-A5(fA8FXsPX^3i`koae;}TAfPqap5~`3s{B?v?DdLPV)2-V>#w~;=!`5>< z*4+hK?xEAfkSZto$e`cgNBcczSJUr9*VC@%B*|X_LRS0$-zwWO1``T&=TdA;G!X<) zAjU4VqNUHX|G(F>KcD>fNWjb2-J2JQ5|xt`6_Mwb;gjX#7Uq+dzDQ?eYXfYWCTT` zw@6tuR4|4c|56}xpbqdW+l?)7wi#pQPM$O3Qu8V-^%M!+sf(e}naK{-RKY-VxfJw1 zv%>c#f(k+*UGJ06?!8DMhV>SaJWZ)%!IK>s;pBJzUibE|$iKg6+M>U(b*FmyPd=hIAC^QfhwG5K9)iO^+2sw0!IUi;d;tna1neZhCk zyLd7D;iYyuK!Lk)qr#zjVaEM;!*3aM!O>AYZi(_WC@j=&uKZj31DY$dx7Z1*r5{n8 z#r=q^EO~~O7?$TwRhHzX51zRB#mQv0%s%>N)iD#W)a5fRP3?e;_6{U-Ta-+8$hUkmU(Y?l-F`{-Xz>u(lppvRXgsS6ntG*-pj^w6p$ z43CX@*2{hpN4B|Jn@Tw>Z6_I1SgojL5*zbKShq5Ko63d)hkU{>1EwHen^8$yed%`J zxI7}FN8zqQT#}oX)3g^Yn$6De6H_Nf&7dO1q2X)iKE+llVzf9>sHDsCj~YfQyYAl6 zloJ?}#Qs2B@ z-1ItoYXeEFIWe0B6eV{YE5vh|!SY$daX#OTk`&wFe8plq3U#_L~&JCM%{y zuKPfdWT#=Y zgwfgt_Yf2Jq&!IwO+-jyIFXu28l`i8$~;^Y~*6X{FSvSfTA(-;vk4Eu+E3P1YZ_ zlfD>-{;bY4N%E-qzTg}GCg=!ft;S$bwk)V9RS)*NI&4wxcZxpsg{mH2g6WYgehYsY=0IKnr)es@~8VUe1Xgu9AOp*|Oh6r0YN{J*2N-`)%sthEw#xA^N9~6V1WxwIZlq{+Z zql}5z3eT8?D;hw|rXb2KbQ>h^Ubkk^>tL7zy?7O{ZL!!DTYXF}-YW|JH|^6J^94e8 zh_45FuuK`#UaNs8;JTsCX|J+A6-^KHF^s=hJ>%{S!|+$Cm}m50h&Q02W3reQm# z#;Q7Iio*Ue38AqcKANe#3X-MM?T1}&hT|p{wy}8~(nP54B_&$X8nBpO+9+xgytxH| zVt{|e1|K^-x0v_+DY^chzZMf-h1cKl+Md=LBI+rl{A?@8KM@yL?Aox){1A!ZY|P40 z+hc;gS|63-+mDMG9(EV1i`=rnk>@x_uQX%QB*8cvR0*EvBnQ6ZLai7a8;{dJnl~XS zGOb}$Wgr4bX0d&;`P`FCX_b5V3$e>gg+-L#hNA|EKJ$e{)M33;P#0`lWW@X}x**^O z2CzB8O0VU7j?OxL8j-I|93*7r;A`Q3bya^_Ml7~&S0+@170LR_1()MeAkpM5h-gSYiL%qB0Kv$4D{ zU))y|Ei&bAN0&B)3XBGbMp+RAtEL`0g3f4{IqweQ6rJgc;Y1*mi3OFJUIS^j7g-Ja|mB>=bhyqK^Dw2 zHRJKK@~yAivY`vaQjU^aeK|{(<5xpE>{i0vJwnwk|0}O0q|Vx%SFh$?vEQN1d(B;6 zZNKPyJ%Rl!qq@vpQ$v-KWLiysl-K!1DIO2~d)$#b9aDEVW-oj|s;F+bcyk7PLQI*X z?O`nie_02`v^(u2%I}8NbQD7Dx}kDzRsd24P~gyokc4cL!gMpx#L;-S5X7lgtSM+l z>x*Z6=ZcOwbKd}YgDMC}Ee+U94-vEaaCqwrrmBUv~Ua-2B#Za`LI5>rxYSaiZQC^Klu( zCa@awJQeNeDtjRs`4)ffbR=*A?yyJ{SrIA^CNX7mF%=DKXW7?x}Wm;;*AoBt)IJCGVFTo8H}n?owD3;0qdttYthN)(;M%Q9X44<)%QG*H{6c&(!z*uovkLEUKiWq!^Dtb{kSrRlZq|P zZs<9<1CC%Py0-joDy-V{oae_?Nbp1}l~t7xRf~&X(=?J`BU_lhKkxk7t?|>sib}P^ zDFm4JHC8EF>?5ijZ{6@1Y;}v z0tZIzLN~IoV;Qk9uRy^R2_J6fy|TKO2{=-v@UKgm)KX81J)X7ZTo~X}I;f${Yn6mT zufMy-8|@#J+O+jH<7UwPSC%8g1iD995n9eiXv0z=VpTf2+8S+#*UbCst4d8|#UNT5 z{&V$xP^2Quy(+SOf4a|xBQ?PWzb+@0OdpLKd@8~oQ$sL^`@}YcPHTfnplKZFC-|3s zADrK_wP2?$l*!Qv#9cH|fA@c3cyIaf@*KA5cDgm;7|Vp=Q#``TmW>?%T z+iF66c;|tLMg~63WM7d-w|tH^!01Da54gI`kj&LsQ$)kTs&<0b(t6O3a3-6}WEU(e z+A+ObdEDy1`(g=ex*@s^`#)yG*24+!JN4VQ0xSpZqM%xohl$?Lqu_i+k}xbxv~mc{ z{D$a^fFWVG@&@8c%ic}WI46*3+_X_~2Q;u&)XhJ)?tK)Ank&^a3F0j{>8ofCl5uN| z4a^1bC-y=`XZ*n2y4~d?>jJiqxy=H5B1vFsnV|uAV8_`M@xs{->3f#NeI;LwS%!}1 zIJVfvaqs9@P1eqfE4Yb!$yLBzRJ|f@#*b}RMhYkb1Q!Uen0i>5p`((QVcX?Qbw6Wu zFH^0ej(1kV9#FFVYFpaC*w0AZmez@RU$XS&OziuS8XYe_IA;kagJs>5L~N^E3g6Pi zN>1jEu!!z;;cR-)AN}pohbNn|hqHG12{DemD&9>5!5qHZb-{{op{}ZYy5ottN=ka2 zv9wFCr3R(9I=mQuy*#UKsBVy(A~3rN@74XvuU{_nA}V)>Ar~{?gLHK$IiwmjZXH`O zXQrR3uTSufj4LvbBXiS;ZHM5ChQ2ucy9vyds<_VnN9U^dwkyTL`A4&6UI;ipGpRJh z5;%ULp>6Q>LB%Ix8JI&9z>dHth9YFFi1>5~NzhP^K50Za5%VZ4Y7{CH+N+Gh^VNs9W8sHB!ceho_>ADAn}QLD?e?+c5;)9U*!u@zs#W?+ z4vfd7HEEUGCvl=B71dbdQ5_Q8Hn!dJX_@t1zZj-idEZ4(b490!YqJxaG`56CJ5Z+K zDJk0!KRxB5WU-Z!(AVLuDZSE4EVX$HU`#%F{$%ax;$oFm&$mu7=SkcFD|0YsyhP z8~|Vh9{fd{`;ao)6Hln4^7txRc4;X`TvLZK51aEY)h)~EU0LTmULpKCy}ioe^ZW8- zcikwe6~TUWgY!9e5`v=H9^)u4(81<*ktss^XuP_{=7lskoqtwyNlbG-^RRJ*SI%%x zj-Es2bbQdN9ve=UvS5EEe5I!@|LwA=Hu3oDjnwcfP#8G$SMS@$S9Tx9#_!-=N1K{L zIB(d_{O1~Fbv}n#9Xo@tN9p?UYvC>;p7*aAl$l8#^NB7PF9agGxlSb0np>Mz$DQ%8 zDFL04D9hrFDvVkSZAna;N^P~a@QdCIgPk?W_=aBhGHf9T9ewqN-p@#5Re4+)75UYL zUY27I?OI=Xe@3NP%{mRQCg1WwD@jfjLWmafU zD63;1-6W31%4scuJbNd$^SfvyPj;oD(FfhH^9(1;wL9IoBa2=JU*{w{}8Qq!J2D_7-`_IOO1id<2N`0N3SuV~>rOdx~xzw%pokTn}k6 zah+b^)*{KPD~bHHa)0+G6yW~d8+t3{i$Xkm>IGB=-g_+=kVr-Ul7$@JTn5 z@r1G@dsdrt-RJa$WF1StENSDBDP&7>_<%6TEP)0U;zPeaV}ws+fko<2H=F74T?Fga zWRt3!A@cL@?wkSUFkmy84}n&;7w6O?Pn@b1sc?H1@7+FoG0q-W@`iWp)CZ5qf*6<< zs2r+fo;3h-z3zI1I_hwL?aBhs3ChNBZjF#p_w zXfINny!2bsV6v(-U9I6yR_0(Xak2N%Z2|a1h5mHz(Jclb6exVAClx%*iStVuu6QNmB4NxLd~v}l8D z?K?xn@jeX2e;P>vEZ|PJ&(W&jsn8Ul4BRI#jK059fGwVYuZ6CMh1|x_BaP`Vu+*Ai zw{ESBrVMpH;XKa0Cq zA_EkGm|`#JZ%X36QTwUeYrg1=k;9VqD`nmN{5x_2dW^*cUF#lhXo&u*F_zk$sh%6| zuPt%N+Bz)f&;7iGaXUX@+uC5*GmQFYCTr4Dtf3ae;gqL8mStk{Z`I1k_~T&6eMDnX zZwmBFXU|h*F3IzzbPM2-)`n(AOH8^FMV=$hNGA+ZMR!zvU+t!i9-Pd1C9^TFs?c zKbG}s?vXMay^;|KRh3gKk-S#{D_K!z$QHO@lNJWS<)7U)+gUN~u%JJKSL=OT@eJmt z%)B>#s>$yJsdv23`H5s&K=lPv7AdW^Z&Vfi_i+apTy#xry2G!9v&XEj6KhI!t5fo#c&{;F-G?W?>d4Gul*f|n^*ln ze#y7f-TFdoy~o&9{a!X%aNvgD7G2SevjwS$7OJhE4V%TVPM(~AV**|o+9?-f zN7z>05|rdty0YTkDQ3PWX&56c*K}2${e2&p-G!o7UJ(Pg0=Jwv>vhXb$=F-GEhi?Q z@c+76%boYqq*!?KWw zJ?8iU!B|rflf}UNCAjsG=Xdt5D|V@DZh|5!s=fs0RVonclxka<^OCJgTyRdEEpuU+ zGo+@7&GUzZva4FU0LcjYot6l0)O0SrDv6XYrX%MxcY`SB*Xydo^q_vw_v=c{^erY) z`bLG(!mE|Q@9^%xtpr5G=)wj@Spwk>gT`=;Ox1TMhM#)3QJ?TCo8M z!qr{H{B!+D`hC;6aIs#D)Xypg>yb1l?C9-95=@aD`sA2PP2Hv?`4zw%u;@`5-t+dc z&0MMq^g-!1y<-Q72}hTbK#gvSfeFJ;luZi#ALiXB!&{GWvgGo;)LZ73Jk=ZA=avGp zyyIID&4`HGHl%7Nq_qgQ>u1 z(l=D?>}V||)1qxx6+nBuUN?Ok*zREQf)UEd?DYq(?b227c&y9YY*NRV6N6)2%F)}yWVn=N^0oCgxT^jKmQ>ajerj! z9DD^0W=4rqadgD&zPSonjpxTj=PVWy?${=N#DQ>SAgn#AxCyK!L2 z6S^qc_0gv$@VRR;6rj;i{OfTm8WFg%Q}KGWI<(V=rKX2#ocUpo0I}Ep+v<$M>!I4n znUC&gZ8(&#&7DxloR{xIN$I%~Ex3wvt-Ks!<$kCg)QR|`G_VzR+lN172JbMtCSd*M zo+Ip1D&Vrz^Dk!Td&k&b4*7vML=3Dc$a;K+2syh-CeV+5+z7OECd~O}xpn{=E?sDP z#|f+t9R_fs7~s>n(VnsAt*plEG-@l|#yES&#s$VBEGSX1e_bBTRV1y3#yFaO4{Y)2{>g;b)sWzUIZe#O`4c=uDhZYXg0K zVznPWSY)DVhOIiMv+iT>bcX03t6u8BE*cqhv9g|i(5usYXA$qr%%IhgGmQ1!%_I)N z-$D2b`}6b1^>`PKzAIIqh-wI^C+pt7W;U-d6u*Z-`W zR*It^&&_nC`{KD*N?n;vN?ku=UD_$PFN1L%%vMo?qHXR=;VY(8+m*l!UEB_;8f&my zU0;A`3o~88Q+wY8C#rCZa-{^l+w{GDfzK=wpAY+Mj5f6IN)npVu~`eqGh&AnRD5EP z<%i$^jEGSXaIk9l;yz|^)!9_iNbtO?ql9KARf#yy=}5@JT>Hez9judD!C(8CYfUX% z3N2mSfu(3wBUI=fp}?cd<+bXhQqm@1Jx~S%5pwQVImWZvS^KtbnGFSiVX)=3PdZ*#Obnw`GHfz z-KPhcC_6p_)1V2@!l{{L8KyU$de4b@*pHVCk_e+CR`jypZgcwoizQ`cH^XA`1or7zJ_*=x_5;@P87z5+AtSp zd?o|$o0cVUa>_?RD+XPQ5A_`wcZ+@8!gOzi%61hePUxtriAD%2meBUx+l%_qY9#{C zR|%}HXT}R_PhrUN3PGfVjCe zY*NNRt|^8bnn0Vu`kxZk{ktFXcgO#Et^bcRMgRBleyxP~u}M;1 zR8i1)C)>IulOfBVzM$j!XpD~kL;vBDKVc-Q5C{c@{1VHGy#4F3Mfebs^k-XBLnTIR z@LRtdZ3N3a&q`p14*sb|>Ow_>XODdq6|}Zc#3Uk3lfd)YnmQtGTr^S!2LQ1F)T1f& zl8dCp*)Sx6HYnZFRj!z7Dqm^B1M?r~?VnBmRsw%N{(bDdef~OCl%HD|$tTDyEr^un zMhc^Z<>VD)W%>9;{x((g-^0J)-{ybw@$;eh{>1;^j@7^7_iy||z)d)SkhUPBR_ru@ z=wTniWk1PPWxP1f!Ni1d8Kx7X`g!V%XVnZAAh!X|8*};I=cbeZ#n+>qvacPw>e)vf z@$oa|oqtNJWHPU!p7GsR-^+b}pF^1h!i<}e`>^KjB290F!tvClKhu^INZn@!()6ip z!NE3gjf-q1rqBd~{rR~zHNG)llJ0aYdabx${D4SWVkmYl$*Fo5jV!ESWTvG(F}xIP z>we}?wC2`a9kCvcB3stcC~?OX=*y5UCwbx_VI`5tXhs;AEQ%XzEev4^9&>f+T- zAFG-0O7;nxy``lgy$s6|mNZ$OqE(#)l|0tjav}YsSZ2N4X4%Uf0OdXk6aEAyk&UFw zkmWs;g|}Ah%|A9u=cwp!(a{LK4f$7$*+281|1$jl52=Fx4*ms^f&zcD{{OKPCjGd3xbP5{9|grC9KTZ{-J`rrvAN>HLgq~zWgZ!0=!r^Kjhblnl(mw4B} zUa%(tlh(TRLV01X&GAF-1Al4em6#v{&6@KF1t(Wdi8nSB%b6K|Q?<{< ztrzmIhMSxAR`a5xuRM;@Bd^8GkJ2ABb1^h?)Si+ei8-iFPC@tY7qqE1Mq0yL<;IJx zkV{n488yRJYW8s1Bl}YxHZ~EPCx+WLFx*ev)+T~|Gi!I7E=$~2??(SArnp%TbXbk|lPjBQmmizCvh>CXCgBkqdZ8r%&o7WbE# z=|(E@DScZcH71RiMZgRQqzod3hyE#-guKbOwo84_IqR`chn{k74=(NOP!Nq8_DhpO z3cDHlX7>)3!8bLQEztgcWHh|4Iz_nBq(oY}^K<-V;oc^k*YO!_O_sCf-VdwaBZCGa zF@Se*Ote~90^$Sh{u~S0#Y*itN~C2EnnP4&Te(9RyI{A09BX9a4^qR}_WY}WuToW? zoPS*oQEm-9?!?~l9N;Nb)nUn3YtpPbPABvxcpb7!qI%R(ZgY$3SKx<|IsDf|%kOV( zm;01znnI>Xi!>WHu-Tnn3NpteF_FQVKWlkaqp?6(cojMW8syst64~Z3TtGrMrH7(Z z{wHst3go)nS-Qr>+P6eD!HkQdapo_H1*Kqoe4sg7jRhGm0>WGBu%mPjcPB$x%YzQo zL`P`KF1Sb8nV!!cT$F?ifg$Ld86^+kZ96;wGmU~Xm`RS23;Xt95Ush6+)3E{wWzf|eNK>Ea8=Sp3$VLw@I3Iuha+%C+yLutwz zTBEK}TP*kmq2_e*b)Qyj{Z(mp^h0vRvaniVnO4pLxd4i6hm!5vr(K(k+t4yv=3{5_ zNG5!))P@*xOv$)X1OqWwNz@OLh`HCBQQ)X*JCiClpX0}#>X~h8D8i*3@8$2;Pt>iQ zvXUrYS>P48l`!hg_&|Xysq~$N`YP=5e&0Gjj``O@Cn*Q(iV%bOJ1v;0r7K7B&cR4O zjPj$|b=UL|X7<9>T(=S2kDueBMImt*AY2Xv5^RNj)eiEl?7SP7+_I^y#|_dDMK3G- za_ZtXiTd`^gF@@FWQwXb@(bn)wnu>xM&?EMoJ5MG9v(cn^H7q3c-+6xg`rCMNk^c7 z@{C4q;b}Gr&r_|Jul#(+j*Os7M1I*=)=x7Gt--%185m+t05s?6vl3N_fdqmGF{0QG zbM8WzIlA|u`^D<@DOgjmu&^9H5ikINldzNk6+j(um*F6M(k2rSZP3|baQ^aRxACo= zqcNV-YpQDDq5}twq(yROa>*}+2loZj+N|SybC0%6N61zd>vQ^M93CcoyEMpfaH+8c z-)eK$xY~a3Bix+Oo^dGjiTtyv2Yed4GlC{anyD>|j*(f<7b3PJ?{3cz5!b$x@nRhW z6_Gz~sur|`Wfh|VO=Pp=@J#XQxTyNy(nqM=`AfWFNkHSaxQb^x4wE>An)ec z4n~;`1@i+P&saHB93}SLmtQ<2-eV5phBReWNo~&A*`p56YF{{E>+r^7 zfpwLK3SjPIA`S>muZA$5z7Lnd)S%90k@f-2LNU9zx$Bb7z0(s}w#W@(RaA zdt;hnbR6;Mj4j9xW_n;Wq^FTyc?I+$~kROXE)MKH-Ci`(RO-D$mKOga7EcTmqH1z z5taP1&P~#dze;kTZWO?wmFbtl;>8=(H|Qnl6KGy!eio>z{=s^VA+GZA!!g!3GV09I zpp!J$!0{n1_vtmF_!%~JFMMEe+TzuLNv33Zro^5_!)VvM%7|wK=QcVaLW|wD{xi{j zfR`qo?JU*KE{{nbZ$ISW1wQS^6_fZLDeMspg?VZ=1Q8gjR7a<1@{yLBE48&h5p5$3 zZ_pdMiUGYFP#L+Nv68KDo`~)kphbx{eV|KPjCZ^Xc?CA;)Ca@|hKcLNn`B(29<#)I zU*Z#P=1jhmoNLFEqY4RvC(bRH-dV~IwPK(Q5&w-oJ5W9j;HM|egm88Tpi9b@3|!=o z!)*zTP~gj+9cvgLA9l1^b^~S#lpS9f5C(*RflVYR+9w3c=%l^oO?-JT_JeVYi_7cL zGeRo5L1`*QYtn0p36cqv-TBjZ!5Zz4)$v|6e!&K{V9wErU70cq1G-^f%JVO zbX3Infk1qSc}r5M5Sqw9#KBBDGXcIY(pWuS`C$LKa>qIj@%bfp#@4903M+-lT}=)fEJ$~y0ZICMP*@M;jip~c)>9xL3gR<6YJ`A-#TLV zYO1=0LaP(S#U2w|tL;Jyv}3mgZiW$C428E$gi}@a|JSxY{jXHw|6iT|2kk!rIV87; zG)kUZPJth(pdctJ$gd#qANK$7|IPm28~=~spZ4E>$~^qdk|6Ly9H5zqp8*|P0TStJ z+`&)tOSH+fOw*|oB7Yq)37V~a+_1#Y1g78sIDp&0p)398Bp>6@NFQ~uyeRUiAeUB# z>^Z(pG4nwZrSB_Oq51D`RF%^ZNyn~tRd);I1#J?W$Ehh4aFI+UR27qXHhGC-{tbGX zTcIvw9$NWHOZV}OZzt(C_>0{5euNJ;m|OguP>~>gALeJzehj~Hu#~VNft|86S>vXN z4MLO=1*QC9;+eH?P07p6Gb&jLY|PPTYR5y}UEwVl?u#SEVRdhz%R z;W{DR$$sI|Ct+IuZ}C$9%kcmA`+xX_|EKs5zktA>`~Uy*@IMAh!~+!I>MTU@Zoo`e zmgqYj(p#UL*DR!ezU7b8xs?`CT+{i^`X+T3U|83a1LOcHfOu&MrWtcD@!)fAbM}(z z=3;%&Li6?4Z=DcjjmE-?UMK@5dw)a-or;Xe6jO+m8jeemNA8_tx2T`#2mzKS4`MyD zpdZGWi3K$wEXrQ2W80~!B%7|jOu_lx6p0~_f%i}MKTx$G@gP|T#w2PAdA7M;C47{o zru~xvId4aXu#(_xn6GlA@oti)_Z)us5~;*F#qJ3-H_a7fy!UhM9dv^68jb#-ZSFAb z3&t^@ep72|Omlg4NYXoxXS;mHJ966Ia`%K1Fu!$gZ?!tQ)SUB|C}CpW(v51aHTggy zBCDB;On!O4l!g%|NbI&Qow}+YYgGN;96?yy2HY*KHo^JKn2ZP_=ri~(z{6}riv6)} zz2#$!yy$}~eUtSTXLH!`y}HpR1xJ>rlt-5u?mVs=s+>ZxU4_1*x%~_T6uOc{uizh? zKxRp;_aB@{E?Ylr^Mf78qS}H&Ia}3!Q!^S!!~p7Xm=Wk`1K>2;J+efr6(jLM>0)ce z?d9n+^QPEqWUhZUn;h^wISHfZKt%BM{pvH6BtvOX<3M3uA9~_Eb3foJw8CjSKIsYV zj(7l3vkFNkNo0lX{VZ|YF7@Q>q?dpW&X!%+v%P9=6?`1n++0~teS{nmAyfn9C@JNL z3a_78rIxQTF9qIijE~_@fAri;!~s}rWo|Rc+}iB1apNLd@5i2&L4*U7uj}&-Ui~F+ zwe$}Q)Q>{tk68tlyQUvf;lht@fXX4Idxx1c-Vaqoati~Zem#czkIl{LqyQN}0#JcS z;zXvVkVAEPg2oF{mQ+_-=5uqaI%+3Kjgu1EB0o39GGgPP(W5;g+N6S~CU&M4)K}xI z)n!RsI~F9EXV%MZ=1oU|{I(uhGeKr8vII|#5~$(hqTHezr^iN0O-rA_>Dc_Sf4Gn~ zjpv7XJrdBIARp4xH;V7XaPr2dnO*#?d%5tAhLjR%S_bX-5% zEYkZ-I=e7=tq77C{g7&aCEVzqkB8&J*}l0^07@&fp9Xi^LIe!qK_I|4J6f-ck~`H` ziJElOHTlU+x-?@b1m>5X-z#uV6j*prRmwBeZ!>rq)wdss9sMZ`j2CY`OPqY{zPj;J zz{lEZRn{t`yHet|6^LV}mIvA!D4d2b|fGFUe<$UBNc3Q>l&S0gTHod|n+=w0%Lja^IXEquD@bUX@SYI-#nYu$J(gT|0g9_8)E? zJpMAQUiwL42$hR@25J9oN4v>tOdq(Cf8pR2>6#j*eJ#!?UmR@<926C=?UNKbBG)Aa zavV(uA;6cIPX;UkzeG%SdXapX|296R6-KW2Iv+f8{E3{wwHR0rsBwi*K`7v1p~)e8 zf7t+H2fB&V&1J|iA);?w1t#j23^uZZU3Dy6$of|mCgDUPB6Wqh-VmZNpcEu@gC-FG zB{U}f@xhwFVjyimv?Cp1qloG)dE#>;I&Ik$y4^*g4-#gZyfq)3dcE}<#5e6n;t!jc z{S*_gcbNO;(i#chvat^M({lE9nl+r-4Tu6YnSU{XIDvA(l}$MHrF)1 z&2J#&?3*X^>UOjt5(fmlzZL9E%9bT0%lgLggzNbM-$>7gZ`Pp?%rbL?MYxEIdFV+kBf!xdTUjiPzZT7!$N|JF_I!`*%e<} zPOu=B4Hd@b7v>0iP^BeiD`@e(7UY_W!6kr&6Dqy<(m7HxgY7pEdI5YaAZ?U`0qyu4 z&UjVQfN4WwJ= znwC=GLbvfb_Fw50-u7O8&bId6yiV3$?)KjQk}`1rPW%svLjG<24*@>GKlQ)A8mE8N zk3Z%;!ek5t2!I1|5C{aL{R3woMuZr`+RY8gg@a(UyX#@^<>l?{_z>qI4h%p5t(YlT z>Xo4hIVb^0jO*<`y+Z%0q4`g_@4t!v|G{?qXS~F}gMU6@q|jf-|4{;e+JFBH!T%li z_`UAQ12>z%ZSXi4(a}c01EHI;Acb(o!&_gR4`eaOJV{Iy5{b9UTz0K90Z_PeZUHzC z;sH{#9twQXH{sM~fg1MCArNq}vFP(|d^bzG-)`p_Q@YQMc9 zf1`S9kdO`{&t8^*x<6-J%}FCtM_zVv4in)o@yvxfi_lLnyyrC(fY=Q)&qF5zoHT)0Swmj10t)x4ljCegXb#<xX)JdUGk2x>AW1gx{yG*%1vGm6#H%p3c-NxI;rAz84MwH(l+53;vbedhGDJpz! zCqx^g2BJDH*etG1U5xJFCkVsn&K7YK%5k^8Qa>^u*(W zZoX?WR^K)(wtH!CLL}6(BT;8iX6Kpd95zHMdGH_?i%H(wR2Um9olc6vg1m=h?Qz5G zEb3`9*K$jH+RZjB7A=@U#R!w?d|pD>=K2tVGHd()(^plgY_55 z4xreKhi{wvyY7h&+1kWYoBnX%8&zIx-|hFmK<<)%Rc#z$&L#Eib65L1DCksV6Ll?$ zX{ez4Jofc-H8TUdI=y#gvfM#9nYC|zh3Jh$;Wlh;9(R+D5y*z*15{i>Wh{NFE6}ke z${~F&co<=+rS;^7&i;fN_H&U2f82+Zx)s$HY@!|8t@tj*SF()RPqcy+UDEMBzyGY{ zg*R$`e%>zmxPtK>MCmW)FA1;;1;S$KX*^=-`icZj&{)2-fV^^&T4Iayby;85vBgpG@V4NP#U zP*zJz-Mtq31Pw>heI(lM;y1%8#r};JqCZ};7#l(BAsB#BK5SsOHX574c&Ool%n6{d9+YhLZ|Q&Cq_&ZMSvnr_Cwd62tr;lSO1ZMf~mmLb#v(&=Wce(_Xj)|Rwuj(0x!>vEJU{+%9Af(LjiJJOf-8T zNJ}+<+vfM1yez$uRxE-RU5VpzpfT4cXEgi5d<%R=2Z;z%lrn-+Z^tzgNKjz;(Y_ z;2TC0F2I_?N9$4UUuah1!>-|K6AuL{vgTjiT{cn4!TYB2Yl4XLCi24xc&(1Jv((2e zs}REYiXah&2!n*z(%XB|_XgO5XoYFkX{sq-2;R~oAJqqA%RIUspTZFTJ}GADTpeLN zQ|@QVBuSGd=nmObyKUZ(`zjF&X5OI93etG?1OpVN0I@+bnKv}fD*1Dci&M@z36c^h z6Mvrpk913MTYg{r74w+Wy=Zsl^nlX)USHk)o{$04j%(5Sy9phL5nwN_B z)*!u=8+}T85Wa^CU=zym5#!jmsgvCKPEi6;Li4A4T(yMIp$L{|fe_+rZX*3|YBP4M zk8N8KFYhYjkwH;Wt!o}uBnEfEHek^)7$cf?(qj=wkgA$MZ-Qdl4*+k=jy&6WfOZ|) zB|1r|y0eFZIc Date: Sun, 26 Apr 2026 14:08:35 +0200 Subject: [PATCH 03/13] replay.t: broaden absolute-path strip beyond `at ... line N` The previous path normalization only matched the diag line shape: s{ at \S+/(t/\S+) line }{ at $1 line }g That works for the one place where a recorded archive's absolute path leaks through into the rendered output today (the `( DIAG ) job N at /t/... line N` line, where Test2's `like()` failure prints the file from caller's __FILE__ at runtime). It does not cover other contexts where a future renderer change might surface an absolute path -- the failure summary table cells, status lines, etc. -- forcing us to extend the regex case-by-case every time the renderer grows a new path-bearing line type. Generalize: strip the absolute-path prefix from any repo-rooted `t/...` reference anywhere in the output. The pattern walks one or more `/segment` components followed by `/(t/...)`, replaces with just the captured `t/...`, and stops at whitespace or `|` so table-cell paths normalise too without crossing cell boundaries. Verified against the original failure shape (diag line), table-cell paths, and status-line paths -- all six test inputs normalise correctly. 10/10 back-to-back local runs pass. CI for the current branch SHA (3ba86fcfa) is green; this change is forward-looking robustness, not a fix for an active failure. Co-Authored-By: Claude --- t/Yath/integration/replay.t | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/t/Yath/integration/replay.t b/t/Yath/integration/replay.t index bd3e972e8..45ebf5f43 100644 --- a/t/Yath/integration/replay.t +++ b/t/Yath/integration/replay.t @@ -35,9 +35,18 @@ sub clean_output { # order so the renderer assigns job 1/2/... differently each run. $out->{output} =~ s/\bjob\s+\d+\b/job N/g; - # Normalize absolute paths in "at /abs/path/t/... line N" diagnostics - # to repo-relative so the golden file is portable across machines. - $out->{output} =~ s{ at \S+/(t/\S+) line }{ at $1 line }g; + # Strip absolute-path prefix from any repo-rooted `t/...` + # reference anywhere in the output. The recorded archive + # carries paths from whichever machine generated it (e.g. + # /home/teo/git/Test2-Harness/t/Yath/integration/replay/fail.tx); + # the golden file holds the canonical repo-relative form + # (t/Yath/integration/replay/fail.tx). Catches the diag line + # `( DIAG ) job N at /t/... line N`, the failure + # summary table cells `| /t/... |`, and any other + # context where a future renderer change might surface an + # absolute path -- so the test stays portable across + # machines without case-by-case patching. + $out->{output} =~ s{/(?:[^/\s|]+/)+(t/[\w./-]+)}{$1}g; my @lines; my $start; From 5b0c9f3830fbff7ba93cb633bd9af19009ae50a0 Mon Sep 17 00:00:00 2001 From: Chad Granum Date: Sat, 25 Apr 2026 14:17:53 -0700 Subject: [PATCH 04/13] cpanfile + dist.ini: bump Atomic::Pipe and IPC::Manager Pull in the streaming-deadlock prereqs: Atomic::Pipe 0.026 (write_blocking fix; required for non-blocking Outbox) IPC::Manager 0.000034 (Role::Outbox + non-blocking service loop + fork-safe DESTROY + ConnectionUnix) Co-Authored-By: Claude Opus 4.7 (1M context) --- cpanfile | 4 ++-- dist.ini | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/cpanfile b/cpanfile index 5ff8009f0..e88a329bc 100644 --- a/cpanfile +++ b/cpanfile @@ -2,7 +2,7 @@ # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "App::Yath::Script" => "2.000011"; -requires "Atomic::Pipe" => "0.021"; +requires "Atomic::Pipe" => "0.026"; requires "B" => "0"; requires "Capture::Tiny" => "0.48"; requires "Carp" => "0"; @@ -40,7 +40,7 @@ requires "IO::Select" => "0"; requires "IO::Uncompress::Bunzip2" => "0"; requires "IO::Uncompress::Gunzip" => "0"; requires "IPC::Cmd" => "0"; -requires "IPC::Manager" => "0.000032"; +requires "IPC::Manager" => "0.000034"; requires "Importer" => "0.025"; requires "JSON::PP" => "0"; requires "LWP" => "0"; diff --git a/dist.ini b/dist.ini index 47803d9ba..d40d26615 100644 --- a/dist.ini +++ b/dist.ini @@ -76,7 +76,7 @@ goto::file = 0.005 mro = 0 parent = 0.241 App::Yath::Script = 2.000011 -Atomic::Pipe = 0.021 +Atomic::Pipe = 0.026 B = 0 Capture::Tiny = 0.48 Carp = 0 @@ -114,7 +114,7 @@ IO::Select = 0 IO::Uncompress::Bunzip2 = 0 IO::Uncompress::Gunzip = 0 IPC::Cmd = 0 -IPC::Manager = 0.000032 +IPC::Manager = 0.000034 Importer = 0.025 JSON::PP = 0 LWP = 0 From 152daaa0269157b6744b6f5e9e4f2906da07d6bb Mon Sep 17 00:00:00 2001 From: Chad Granum Date: Sat, 25 Apr 2026 14:18:03 -0700 Subject: [PATCH 05/13] streaming-deadlock: non-blocking sends + drain-before-finish Replaces the unbounded blocking-pipe writes that were deadlocking the test command on a slow harness. The fix has four coordinated pieces -- collector outbox, harness idle protocol, test-command drain, and Outbox-aware test stubs -- that all have to land together for the system to keep working. Test2::Harness2::Collector - _ipc_client switches the client to send_blocking=0 at construction; events flow through try_send_message and queue on EAGAIN. - The collection loop drains the outbox at the top of each iteration and includes any backlogged writable handles in the IO::Select wait so the loop wakes the moment the kernel makes room. - _exit_mirroring_child drains for up to 5s before _exit so events queued during the run are not dropped on shutdown. - _send_to keeps its retry-on-peer-disappear loop, now driven by try_send_message instead of send_message. Test2::Harness2 (control plane) - request_handler_has_pending_messages returns {ok, idle, pending, running, queued}; the current request itself is excluded from the pending count because the response is queued AFTER the handler returns. Test2::Harness2::Spawn - has_pending_messages: single non-blocking idle check. - wait_until_idle(\$timeout): poll until idle or deadline (default 30 s, 0 = unbounded). Peer-gone errors count as idle. - finish() drains via wait_until_idle(30) before sending the finish request so non-blocking sends made during the run are not dropped. App::Yath2::Command::test - Drains the harness via wait_until_idle before issuing finish. t/AI test stubs - Collector and replay/run unit-test fakes that stub IPC::Manager::Client extend their fake clients with the Outbox API (try_send_message, pending_sends, drain_pending, have_writable_handles, set_send_blocking) so the new collector-side code paths exercise correctly under the stubs. Co-Authored-By: Claude Opus 4.7 (1M context) --- lib/App/Yath2/Command/test.pm | 8 +++ lib/Test2/Harness2.pm | 40 +++++++++++ lib/Test2/Harness2/Collector.pm | 70 ++++++++++++++++++-- lib/Test2/Harness2/Spawn.pm | 56 +++++++++++++++- t/AI/unit/Collector.t | 25 +++++-- t/AI/unit/Collector/burst_sync.t | 13 +++- t/AI/unit/Harness2/Role/Collector/Observer.t | 13 +++- t/AI/unit/Harness2/Spawn/finish_race.t | 4 ++ 8 files changed, 213 insertions(+), 16 deletions(-) diff --git a/lib/App/Yath2/Command/test.pm b/lib/App/Yath2/Command/test.pm index 14578da91..b464ade0b 100644 --- a/lib/App/Yath2/Command/test.pm +++ b/lib/App/Yath2/Command/test.pm @@ -204,6 +204,14 @@ sub run { # around to accept these requests. eval { $spawn->unsubscribe; 1 } or warn $@; + # Wait for the harness to drain any events still queued for us + # before we tell it to finish. The has_pending_messages request + # itself does not count as pending work (its response is queued + # AFTER the handler returns). Cap at 30 seconds; on timeout we + # proceed anyway because the run is over and any straggler + # events at that point are not worth blocking exit on. + eval { $spawn->wait_until_idle(30); 1 } or warn $@; + # Drop the streamer explicitly: it holds a reference to $spawn, # which is what keeps the IPC handle (and its AtomicPipe client) # alive. Without this, the client's pre_disconnect_hook fires diff --git a/lib/Test2/Harness2.pm b/lib/Test2/Harness2.pm index 3cd78ccb8..639433045 100644 --- a/lib/Test2/Harness2.pm +++ b/lib/Test2/Harness2.pm @@ -460,6 +460,46 @@ sub request_handler_finish { return {ok => 1}; } +# Idle-check used by the test command (and any caller that wants to +# wait for the harness to drain before requesting termination). +# Returns {ok => 1, idle => 1} when there is no other pending work +# the harness still needs to do for the asking peer: +# +# - the harness's outbox to that peer is empty +# - no runs are active or queued +# - no in-flight subscription deltas remain +# +# The current request itself is NOT counted: the response that goes +# back is queued AFTER this handler returns, so at handler-time the +# outbox does not yet contain it. The caller therefore polls until +# idle == 1, then issues finish/terminate without racing pending +# events. +sub request_handler_has_pending_messages { + my ($self, $payload, $msg) = @_; + + my $peer = $payload->{peer} // ($msg ? $msg->from : undef) + or return {ok => 0, error => "'peer' is required (or supply a from-bearing msg)"}; + + my $client = $self->client; + + # IPC::Manager 0.000034 (cpanfile minimum) provides the full + # Outbox API as no-op fallbacks on every client backend, so + # pending_sends_to is always callable -- non-Outbox clients + # return 0 without walking anything. + my $pending = $client->pending_sends_to($peer); + + my $running = scalar keys %{$self->{+RUN_SERVICES} // {}}; + my $queued = scalar @{$self->{+QUEUE} // []}; + + return { + ok => 1, + idle => ($pending == 0 && $running == 0 && $queued == 0) ? 1 : 0, + pending => $pending, + running => $running, + queued => $queued, + }; +} + # Per-run pass/fail + per-job verdicts. A completed run's final # snapshot is stashed in COMPLETED_RUNS by _handle_run_state_update # at the moment it sees the run close out; this handler serves from diff --git a/lib/Test2/Harness2/Collector.pm b/lib/Test2/Harness2/Collector.pm index b195d6581..6348a8b38 100644 --- a/lib/Test2/Harness2/Collector.pm +++ b/lib/Test2/Harness2/Collector.pm @@ -725,7 +725,15 @@ sub _ipc_client { return $self->{_ipc_client} if $self->{_ipc_client}; require IPC::Manager; - return $self->{_ipc_client} = IPC::Manager->connect($self->bus_id, $self->{+IPCM_INFO}); + my $c = IPC::Manager->connect($self->bus_id, $self->{+IPCM_INFO}); + + # The collector runs an event loop. Sends never block: queued + # messages are flushed by the loop's per-iteration drain (see + # _run_collection_loop). Clients without Role::Outbox inherit + # the no-op set_send_blocking from IPC::Manager::Client base. + $c->set_send_blocking(0); + + return $self->{_ipc_client} = $c; } # Wait briefly for $target to register on the bus so the first @@ -821,16 +829,20 @@ sub _send_to { my $client = $self->_ipc_client; - # Send with one retry. The MessageFiles protocol's send_message + # Send with one retry. The MessageFiles protocol's try_send_message # croaks "Client does not exist" if the target's peer directory # is missing at send time; that can race with peer registration # at startup or peer teardown at shutdown. Re-check peer_active # once before giving up so the legitimately-late but still-alive # case stops emitting spurious warnings. + # + # try_send_message is non-blocking: queues on EAGAIN. The + # collection loop calls drain_pending each iteration to flush + # the queue when the transport reports writability. for my $attempt (1, 2) { my $ready = $self->_wait_for_ipc_target($target); - my $ok = eval { $client->send_message($target, $content); 1 }; + my $ok = eval { $client->try_send_message($target, $content); 1 }; return if $ok; my $err = $@; @@ -975,7 +987,37 @@ sub _run_collection_loop { my $draining = 0; # Set when we got a signal/parent-gone and are finishing up while (1) { - $sel->can_read($cycle) if $sel->count; + # Flush any queued outbound IPC sends. The client is in + # send_blocking=0 mode (set by _ipc_client). The kernel may + # have made room in the FIFO since the previous iteration. + # have_pending_sends short-circuits on the first peer with a + # backlog; pending_sends would walk every peer summing queue + # depths, which is wasted work on the hot path. + my $client = $self->{_ipc_client}; + $client->drain_pending if $client && $client->have_pending_sends; + + # Build a write-side select set when the outbox has a + # backlog so the loop wakes the moment room appears, even + # on platforms without large pipe buffers. + my $write_sel; + if ($client && $client->have_writable_handles) { + require IO::Select; + my @wh = $client->writable_handles; + if (@wh) { + $write_sel = IO::Select->new; + $write_sel->add(@wh); + } + } + + if ($sel->count || $write_sel) { + require IO::Select; + IO::Select->select($sel->count ? $sel : undef, $write_sel, undef, $cycle); + } + + # Post-select drain: writable wake-up means the queue can + # advance now. Read-side wake-up may also have made room + # transitively. + $client->drain_pending if $client && $client->have_pending_sends; my $ok = eval { # Check for signal - kill child but keep draining handles @@ -1622,6 +1664,26 @@ sub _exit_mirroring_child { my $self = shift; my ($collector_ok) = @_; + # Drain any queued outbound IPC sends before exit. The collector + # was running in send_blocking=0 mode (set by _ipc_client) so + # events accumulated during the run are still in the client's + # outbox; without this drain they would be dropped when this + # process _exits. Loop until the queue clears or a 5s deadline + # is hit (avoid wedging an exit on a peer that isn't reading). + if (my $client = $self->{_ipc_client}) { + # The Outbox API (have_pending_sends + drain_pending) is + # provided as a no-op fallback by the IPC::Manager::Client + # base class for backends that do not consume Role::Outbox, + # so no can() gate is needed -- non-Outbox clients exit the + # loop after the first iteration when have_pending_sends + # returns 0. + my $deadline = time + 5; + while ($client->have_pending_sends && time < $deadline) { + last unless $client->drain_pending; + tinysleep(0.01) if $client->have_pending_sends; + } + } + POSIX::_exit(255) unless $collector_ok; if (defined(my $child_exit = $self->{+CHILD_EXIT})) { diff --git a/lib/Test2/Harness2/Spawn.pm b/lib/Test2/Harness2/Spawn.pm index 0c505dd00..e42348aeb 100644 --- a/lib/Test2/Harness2/Spawn.pm +++ b/lib/Test2/Harness2/Spawn.pm @@ -6,6 +6,7 @@ our $VERSION = '2.000011'; use Carp qw/croak/; use POSIX qw/:sys_wait_h/; +use Time::HiRes (); use Object::HashBase qw{ _send_request_race_safe('finish') } +sub finish { + my $self = shift; + # Drain queued events from the harness's outbox before asking + # it to terminate, so non-blocking sends made during the run + # are not dropped on exit. Cap at 30 s; on timeout we proceed + # because the run is over and any straggler events are not + # worth blocking exit on. Failures during the wait (peer-gone, + # etc.) are tolerated -- finish itself uses the race-safe send. + eval { $self->wait_until_idle(30); 1 } or warn $@; + return $self->_send_request_race_safe('finish'); +} + +# Single non-blocking idle check. Returns the harness's response +# hashref: { ok => 1, idle => 0|1, pending => N, running => N, +# queued => N }. The current request itself is excluded from the +# pending count (the response goes back AFTER the handler returns). +sub has_pending_messages { + my $self = shift; + return $self->_send_request('has_pending_messages'); +} + +# Poll until the harness reports idle for our peer, or $timeout +# seconds elapse. Returns 1 if idle was reached, 0 on timeout. The +# default timeout is 30 seconds; pass 0 for unbounded polling. Each +# poll uses a sync_request whose response itself does not count as +# pending work. +sub wait_until_idle { + my $self = shift; + my ($timeout) = @_; + $timeout //= 30; + + my $deadline; + $deadline = time + $timeout if $timeout; + + while (1) { + my $res; + my $ok = eval { $res = $self->has_pending_messages; 1 }; + # If the peer is gone or the request failed because the + # peer is no longer a valid recipient, treat that as idle: + # there is nothing more for us to wait for. + unless ($ok) { + return 1 if $@ =~ /not a valid message recipient/; + return 1 if $@ =~ $PEER_GONE; + die $@; + } + return 1 if $res && $res->{ok} && $res->{idle}; + + if (defined $deadline) { + return 0 if time >= $deadline; + } + + Time::HiRes::sleep(0.05); + } +} # Ask the harness to forward state and/or artifact updates to this # handle's IPC client. %params are the harness's subscribe payload: diff --git a/t/AI/unit/Collector.t b/t/AI/unit/Collector.t index d807261e6..3086158ba 100644 --- a/t/AI/unit/Collector.t +++ b/t/AI/unit/Collector.t @@ -38,9 +38,16 @@ BEGIN { *IPC::Manager::connect = sub { return bless {}, 'T2H2_TestNoopClient'; }; - *T2H2_TestNoopClient::send_message = sub { return }; - *T2H2_TestNoopClient::peer_active = sub { 1 }; - *T2H2_TestNoopClient::disconnect = sub { return }; + *T2H2_TestNoopClient::send_message = sub { return }; + *T2H2_TestNoopClient::try_send_message = sub { return 1 }; + *T2H2_TestNoopClient::peer_active = sub { 1 }; + *T2H2_TestNoopClient::disconnect = sub { return }; + *T2H2_TestNoopClient::pending_sends = sub { 0 }; + *T2H2_TestNoopClient::have_pending_sends = sub { 0 }; + *T2H2_TestNoopClient::drain_pending = sub { 0 }; + *T2H2_TestNoopClient::have_writable_handles = sub { 0 }; + *T2H2_TestNoopClient::writable_handles = sub { () }; + *T2H2_TestNoopClient::set_send_blocking = sub { return }; } my $IS_WIN32 = $^O eq 'MSWin32'; @@ -1695,6 +1702,8 @@ subtest '_send_logger_metadata groups metadata and registers under the collector push @{$self->{sent}} => {to => $to, payload => $payload}; return; }; + *T2H2_FakeClient_LMeta::try_send_message = sub { my $self = shift; $self->send_message(@_); 1 }; + *T2H2_FakeClient_LMeta::set_send_blocking = sub { return }; # Two JSONL loggers at different paths to show class keys map to arrayrefs. my $jsonl_a = Test2::Harness2::Collector::Logger::JSONL->new( @@ -1757,6 +1766,8 @@ subtest '_send_logger_metadata omits loggers whose metadata is undef' => sub { push @{$self->{sent}} => $payload; return; }; + *T2H2_FakeClient_Omit::try_send_message = sub { my $self = shift; $self->send_message(@_); 1 }; + *T2H2_FakeClient_Omit::set_send_blocking = sub { return }; # JSONL produces metadata; the bare role default is undef. my $jsonl = Test2::Harness2::Collector::Logger::JSONL->new( @@ -1800,6 +1811,8 @@ subtest '_send_logger_metadata still fires when every logger returns undef' => s push @{$self->{sent}} => $payload; return; }; + *T2H2_FakeClient_Empty::try_send_message = sub { my $self = shift; $self->send_message(@_); 1 }; + *T2H2_FakeClient_Empty::set_send_blocking = sub { return }; my $silent = T2H2_SilentLogger->new; @@ -1824,8 +1837,10 @@ subtest '_send_logger_metadata warns on IPC failure, does not propagate' => sub local *IPC::Manager::connect = sub { return bless {}, 'T2H2_FakeClient_Die'; }; - local *T2H2_FakeClient_Die::peer_active = sub { 1 }; - local *T2H2_FakeClient_Die::send_message = sub { die "no route to peer\n" }; + local *T2H2_FakeClient_Die::peer_active = sub { 1 }; + local *T2H2_FakeClient_Die::send_message = sub { die "no route to peer\n" }; + local *T2H2_FakeClient_Die::try_send_message = sub { my $self = shift; $self->send_message(@_); 1 }; + local *T2H2_FakeClient_Die::set_send_blocking = sub { return }; my $jsonl = Test2::Harness2::Collector::Logger::JSONL->new( ipcm_info => {}, output_file => '/tmp/x.jsonl', diff --git a/t/AI/unit/Collector/burst_sync.t b/t/AI/unit/Collector/burst_sync.t index 911de19b1..7a03d434b 100644 --- a/t/AI/unit/Collector/burst_sync.t +++ b/t/AI/unit/Collector/burst_sync.t @@ -25,9 +25,16 @@ BEGIN { *IPC::Manager::connect = sub { return bless {}, 'T2H2_BurstSync_NoopClient'; }; - *T2H2_BurstSync_NoopClient::send_message = sub { return }; - *T2H2_BurstSync_NoopClient::peer_active = sub { 1 }; - *T2H2_BurstSync_NoopClient::disconnect = sub { return }; + *T2H2_BurstSync_NoopClient::send_message = sub { return }; + *T2H2_BurstSync_NoopClient::try_send_message = sub { return 1 }; + *T2H2_BurstSync_NoopClient::peer_active = sub { 1 }; + *T2H2_BurstSync_NoopClient::disconnect = sub { return }; + *T2H2_BurstSync_NoopClient::pending_sends = sub { 0 }; + *T2H2_BurstSync_NoopClient::have_pending_sends = sub { 0 }; + *T2H2_BurstSync_NoopClient::drain_pending = sub { 0 }; + *T2H2_BurstSync_NoopClient::have_writable_handles = sub { 0 }; + *T2H2_BurstSync_NoopClient::writable_handles = sub { () }; + *T2H2_BurstSync_NoopClient::set_send_blocking = sub { return }; } my $tmpdir = tempdir(CLEANUP => 1); diff --git a/t/AI/unit/Harness2/Role/Collector/Observer.t b/t/AI/unit/Harness2/Role/Collector/Observer.t index c3ddeec11..c5690dc59 100644 --- a/t/AI/unit/Harness2/Role/Collector/Observer.t +++ b/t/AI/unit/Harness2/Role/Collector/Observer.t @@ -67,9 +67,16 @@ BEGIN { require IPC::Manager; no warnings 'once', 'redefine'; *IPC::Manager::connect = sub { bless {}, 'T2H2_ObsNoopClient' }; - *T2H2_ObsNoopClient::send_message = sub { }; - *T2H2_ObsNoopClient::peer_active = sub { 1 }; - *T2H2_ObsNoopClient::disconnect = sub { }; + *T2H2_ObsNoopClient::send_message = sub { }; + *T2H2_ObsNoopClient::try_send_message = sub { 1 }; + *T2H2_ObsNoopClient::peer_active = sub { 1 }; + *T2H2_ObsNoopClient::disconnect = sub { }; + *T2H2_ObsNoopClient::pending_sends = sub { 0 }; + *T2H2_ObsNoopClient::have_pending_sends = sub { 0 }; + *T2H2_ObsNoopClient::drain_pending = sub { 0 }; + *T2H2_ObsNoopClient::have_writable_handles = sub { 0 }; + *T2H2_ObsNoopClient::writable_handles = sub { () }; + *T2H2_ObsNoopClient::set_send_blocking = sub { return }; } my $CAN_FORK = $Config{d_fork}; diff --git a/t/AI/unit/Harness2/Spawn/finish_race.t b/t/AI/unit/Harness2/Spawn/finish_race.t index c7e3210dd..8afb45622 100644 --- a/t/AI/unit/Harness2/Spawn/finish_race.t +++ b/t/AI/unit/Harness2/Spawn/finish_race.t @@ -29,6 +29,7 @@ subtest 'finish() returns cleanly on success' => sub { my @called; no warnings 'redefine'; + local *Test2::Harness2::Spawn::wait_until_idle = sub { 1 }; local *Test2::Harness2::Spawn::_send_request = sub { push @called => $_[1]; return {ok => 1}; @@ -46,6 +47,7 @@ subtest 'finish() absorbs peer-gone "went away" error' => sub { my $spawn = make_spawn(); no warnings 'redefine'; + local *Test2::Harness2::Spawn::wait_until_idle = sub { 1 }; local *Test2::Harness2::Spawn::_send_request = sub { die "$PEER_GONE_AWAIT\n" }; my $ok = eval { $spawn->finish; 1 }; @@ -59,6 +61,7 @@ subtest 'finish() absorbs peer-gone "not a valid recipient" error' => sub { my $spawn = make_spawn(); no warnings 'redefine'; + local *Test2::Harness2::Spawn::wait_until_idle = sub { 1 }; local *Test2::Harness2::Spawn::_send_request = sub { die "$PEER_GONE_RECIP\n" }; my $ok = eval { $spawn->finish; 1 }; @@ -72,6 +75,7 @@ subtest 'finish() propagates non-peer-gone errors' => sub { my $spawn = make_spawn(); no warnings 'redefine'; + local *Test2::Harness2::Spawn::wait_until_idle = sub { 1 }; local *Test2::Harness2::Spawn::_send_request = sub { die "$OTHER_ERROR\n" }; my $ok = eval { $spawn->finish; 1 }; From a6b4531444db09b0166d58af3e92256b4d97e894 Mon Sep 17 00:00:00 2001 From: Chad Granum Date: Sun, 26 Apr 2026 04:05:40 -0700 Subject: [PATCH 06/13] ipc: default to ConnectionUnix + JSON::Zstd with shared dictionary Centralizes the harness's IPC defaults in Test2::Harness2::Util::IPC and applies them at every call site: ipc_default_protocol -> IPC::Manager::Client::ConnectionUnix ipc_default_serializer -> ['JSON::Zstd', level => 3, dictionary => share/other/zstd.dict] ipc_zstd_dict_path -> File::ShareDir::dist_file lookup (undef when uninstalled) ipc_default_spawn_args -> kwargs for ipcm_spawn ipc_default_connect_args -> (listen => 0) for non-services ConnectionUnix builds a per-peer SOCK_STREAM driver with an optional listen socket. Services keep listen=1 (Role::Service's client builder is unchanged) so peers can reach them; the collector and the parent-side Test2::Harness2::Spawn handle now connect with listen=0, since they only ever send upward. Test2::Harness2::Spawn pre-builds its IPC client with listen=0 and hands it to IPC::Manager::Service::Handle->new via the +client slot, bypassing the Handle's lazy listening builder. JSON::Zstd's dictionary is resolved via File::ShareDir::dist_file ('Test2-Harness2', 'other/zstd.dict'); both endpoints must land on the same dictionary path with identical content, which the shared install location guarantees. When the share file is unavailable (uninstalled checkouts without ShareDir staging) the serializer falls back to dictless compression rather than failing. App::Yath2::Options::IPC's --ipc-protocol default also flips from MessageFiles to ConnectionUnix so the option layer agrees with the underlying default. Co-Authored-By: Claude Opus 4.7 (1M context) --- lib/App/Yath2/Options/IPC.pm | 5 +- lib/Test2/Harness2.pm | 45 +++++++++--------- lib/Test2/Harness2/Collector.pm | 22 +++++---- lib/Test2/Harness2/Spawn.pm | 15 +++++- lib/Test2/Harness2/Util/IPC.pm | 65 +++++++++++++++++++++++++- t/AI/unit/Harness2/Util/IPC_defaults.t | 64 +++++++++++++++++++++++++ 6 files changed, 181 insertions(+), 35 deletions(-) create mode 100644 t/AI/unit/Harness2/Util/IPC_defaults.t diff --git a/lib/App/Yath2/Options/IPC.pm b/lib/App/Yath2/Options/IPC.pm index 6eaf0a5a0..45dbcf6a4 100644 --- a/lib/App/Yath2/Options/IPC.pm +++ b/lib/App/Yath2/Options/IPC.pm @@ -35,8 +35,9 @@ option_group {group => 'ipc', category => 'IPC Options'} => sub { option protocol => ( name => 'ipc-protocol', type => 'Scalar', - description => 'IPC::Manager client driver (default MessageFiles). ' . 'Use "+Some::Class" to force a fully qualified namespace.', + description => 'IPC::Manager client driver (default ConnectionUnix). ' . 'Use "+Some::Class" to force a fully qualified namespace.', long_examples => [ + ' ConnectionUnix', ' AtomicPipe', ' UnixSocket', ' JSONFile', @@ -45,7 +46,7 @@ option_group {group => 'ipc', category => 'IPC Options'} => sub { ' SQLite', ' +Custom::Driver', ], - default => sub { 'IPC::Manager::Client::MessageFiles' }, + default => sub { 'IPC::Manager::Client::ConnectionUnix' }, normalize => \&_normalize_protocol, ); diff --git a/lib/Test2/Harness2.pm b/lib/Test2/Harness2.pm index 639433045..2412837ee 100644 --- a/lib/Test2/Harness2.pm +++ b/lib/Test2/Harness2.pm @@ -8,11 +8,12 @@ use Carp qw/croak/; use File::Copy qw/cp/; use File::Path qw/make_path/; use File::ShareDir (); -use File::Spec (); +use File::Spec (); use Scalar::Util qw/blessed/; use Time::HiRes qw/time/; use Test2::Util::UUID qw/gen_uuid/; use Test2::Harness2::Util qw/parse_exit tinysleep load_module/; +use Test2::Harness2::Util::IPC qw/ipc_default_spawn_args/; use POSIX qw/WNOHANG/; use Atomic::Pipe; @@ -141,9 +142,7 @@ sub init { } } else { - my $share = eval { - File::ShareDir::dist_file('Test2-Harness2', 'other/zstd.dict'); - }; + my $share = eval { File::ShareDir::dist_file('Test2-Harness2', 'other/zstd.dict'); }; $self->{+DICT_PATH} = (defined $share && -f $share) ? $share : undef; } @@ -243,7 +242,7 @@ sub start { # guard never fires in either the service child or the collector parent. my $ipcm_guard; unless ($args{ipcm_info}) { - $ipcm_guard = ipcm_spawn(); + $ipcm_guard = ipcm_spawn(ipc_default_spawn_args()); $args{ipcm_info} = $ipcm_guard->info; } @@ -319,7 +318,9 @@ sub spawn { # Spawn the IPC bus in the parent so both parent and child share the same # connection info. Use guard => 0 so the parent does not try to tear down # the bus when the Spawn object goes out of scope; the child owns it. - my @ipcm_args = (guard => 0); + # Caller-supplied $protocol is appended last so it overrides the default + # protocol from ipc_default_spawn_args(). + my @ipcm_args = (ipc_default_spawn_args(), guard => 0); push @ipcm_args => (protocol => $protocol) if defined $protocol && length $protocol; my $ipcm = ipcm_spawn(@ipcm_args); $args{ipcm_info} = $ipcm->info; @@ -489,7 +490,7 @@ sub request_handler_has_pending_messages { my $pending = $client->pending_sends_to($peer); my $running = scalar keys %{$self->{+RUN_SERVICES} // {}}; - my $queued = scalar @{$self->{+QUEUE} // []}; + my $queued = scalar @{$self->{+QUEUE} // []}; return { ok => 1, @@ -713,10 +714,10 @@ sub _write_artifacts_manifest { my $path = "$self->{+LOGDIR}/artifacts.json.zst"; - my $dict = "$self->{+LOGDIR}/zstd-dict.bin"; + my $dict = "$self->{+LOGDIR}/zstd-dict.bin"; my @dict_args = -f $dict ? (dict_path => $dict) : (); - my $ok = eval { + my $ok = eval { write_json_zst_file_atomic($path, $self->{+ARTIFACTS}, @dict_args); 1; }; @@ -789,8 +790,8 @@ sub request_handler_subscribe { my $artifacts = $payload->{artifacts} ? 1 : 0; my @run_ids; - push @run_ids => $payload->{run} if defined $payload->{run}; - push @run_ids => @{$payload->{runs}} if ref($payload->{runs}) eq 'ARRAY'; + push @run_ids => $payload->{run} if defined $payload->{run}; + push @run_ids => @{$payload->{runs}} if ref($payload->{runs}) eq 'ARRAY'; # Validate every run_id up front. The harness knows about runs in # the live queue and in COMPLETED_RUNS (terminal snapshots). @@ -857,10 +858,10 @@ sub _notify_state_subscribers { $self->_send_to_subscriber( $peer => { - type => 'state', - item => 'run', - run_id => $run_id, - state => $run_data, + type => 'state', + item => 'run', + run_id => $run_id, + state => $run_data, }, ); } @@ -942,7 +943,7 @@ sub _send_artifact_snapshot { $artifacts = { map { $_ => $all->{$_} } grep { m{^runs/\Q$run_id\E(?:[./]|\z)} } - keys %$all + keys %$all }; } else { @@ -976,7 +977,7 @@ sub _send_artifact_snapshot { sub _send_to_subscriber { my ($self, $peer, $payload) = @_; - my $ok = eval { $self->client->send_message($peer, $payload); 1 }; + my $ok = eval { $self->client->send_message($peer, $payload); 1 }; my $err = $@; return if $ok; @@ -1013,8 +1014,8 @@ sub _drain_subscriber_retries { my $peer_gone = 0; for my $i (0 .. $#queue) { my $payload = $queue[$i]; - my $ok = eval { $self->client->send_message($peer, $payload); 1 }; - my $err = $@; + my $ok = eval { $self->client->send_message($peer, $payload); 1 }; + my $err = $@; next if $ok; @@ -1117,7 +1118,7 @@ sub _snapshot_run_results { # Entries without completed_at are queue-time or started-time # seeds (jobs that never finished or were skipped). Only # completed jobs contribute to the aggregate verdict. - next unless defined $results->{$jid}{completed_at}; + next unless defined $results->{$jid}{completed_at}; $all_pass = 0 unless $results->{$jid}{pass}; } @@ -1394,9 +1395,9 @@ sub _scheduler_started { sub _scheduler_mark_running { my ($self, $run_id, $job_id) = @_; my $s = $self->{+SCHEDULER}->{$run_id} or return; - $s->{pending} = [grep { $_ ne $job_id } @{$s->{pending}}]; + $s->{pending} = [grep { $_ ne $job_id } @{$s->{pending}}]; $s->{running}->{$job_id} = 1; - $s->{started} = 1; + $s->{started} = 1; return; } diff --git a/lib/Test2/Harness2/Collector.pm b/lib/Test2/Harness2/Collector.pm index 6348a8b38..dd203b5cd 100644 --- a/lib/Test2/Harness2/Collector.pm +++ b/lib/Test2/Harness2/Collector.pm @@ -21,7 +21,7 @@ use Test2::Harness2::Collector::FileLineReader; use Test2::Harness2::Collector::Handle; use Test2::Harness2::Util qw/load_module parse_exit tinysleep/; use Test2::Harness2::Util::JSON qw/encode_json encode_json_file decode_json/; -use Test2::Harness2::Util::IPC qw/pid_is_running set_procname swap_io/; +use Test2::Harness2::Util::IPC qw/pid_is_running set_procname swap_io ipc_default_connect_args/; # This is the base class. Two subclasses add the test-vs-service # divergent behaviour: Test2::Harness2::Collector::Test carries an @@ -725,7 +725,12 @@ sub _ipc_client { return $self->{_ipc_client} if $self->{_ipc_client}; require IPC::Manager; - my $c = IPC::Manager->connect($self->bus_id, $self->{+IPCM_INFO}); + # listen=0 (from ipc_default_connect_args): the collector only + # ever sends UPWARD and never receives inbound traffic, so on + # ConnectionUnix it skips the listen socket entirely. Drivers + # that ignore the flag (MessageFiles, AtomicPipe, etc.) treat + # the kwarg as a no-op. + my $c = IPC::Manager->connect($self->bus_id, $self->{+IPCM_INFO}, ipc_default_connect_args()); # The collector runs an event loop. Sends never block: queued # messages are flushed by the loop's per-iteration drain (see @@ -1298,8 +1303,7 @@ sub _check_new_pgroup_supported_on_win32 { # is required for Invariant 1 (child-process isolation). my $has_win32_job = eval { require Win32::Job; 1 }; unless ($has_win32_job) { - croak "new_pgroup => 1 on Windows requires Win32::Job (not installed); " - . "install Win32::Job to enable process-group isolation"; + croak "new_pgroup => 1 on Windows requires Win32::Job (not installed); " . "install Win32::Job to enable process-group isolation"; } } @@ -1374,10 +1378,12 @@ sub _launch_child_win32_job { # Pass the pipe write ends as the child's stdout/stderr. # Win32::Job->spawn accepts filehandles for stdin/stdout/stderr and # marks them inheritable before calling CreateProcess. - my $pid = $job->spawn($exe, $cmdline, { - stdout => $out_w->wh, - stderr => $err_w->wh, - }); + my $pid = $job->spawn( + $exe, $cmdline, { + stdout => $out_w->wh, + stderr => $err_w->wh, + } + ); croak "Win32::Job->spawn('$exe') failed: $^E" unless defined $pid && $pid > 0; diff --git a/lib/Test2/Harness2/Spawn.pm b/lib/Test2/Harness2/Spawn.pm index e42348aeb..4d6de8b2a 100644 --- a/lib/Test2/Harness2/Spawn.pm +++ b/lib/Test2/Harness2/Spawn.pm @@ -8,6 +8,8 @@ use Carp qw/croak/; use POSIX qw/:sys_wait_h/; use Time::HiRes (); +use Test2::Harness2::Util::IPC qw/ipc_default_connect_args/; + use Object::HashBase qw{ {+NAME} . '-spawn-' . $$; + my $client = IPC::Manager->connect($handle_name, $self->{+IPCM_INFO}, ipc_default_connect_args()); + return IPC::Manager::Service::Handle->new( service_name => $self->{+NAME}, + name => $handle_name, ipcm_info => $self->{+IPCM_INFO}, + client => $client, ); } @@ -175,7 +189,6 @@ sub run_results { return $self->_send_request('run_results', \%args); } - sub terminate { my $self = shift; my $res; diff --git a/lib/Test2/Harness2/Util/IPC.pm b/lib/Test2/Harness2/Util/IPC.pm index 865b43378..084eea062 100644 --- a/lib/Test2/Harness2/Util/IPC.pm +++ b/lib/Test2/Harness2/Util/IPC.pm @@ -6,6 +6,7 @@ our $VERSION = '2.000011'; use Carp qw/croak confess/; use Errno qw/ESRCH/; +use File::ShareDir (); # /proc layouts we know how to parse: Linux's multi-line "PPid:" form # and FreeBSD/DragonFlyBSD's single-line positional form. Solaris, @@ -13,8 +14,20 @@ use Errno qw/ESRCH/; # doesn't handle -- on those platforms we fall through to ps even if # /proc happens to be mounted, so we can't misread a binary status # blob as text and return garbage. -use constant HAS_PARSEABLE_PROC => - ($^O eq 'linux' || $^O eq 'freebsd' || $^O eq 'dragonfly'); +use constant HAS_PARSEABLE_PROC => ($^O eq 'linux' || $^O eq 'freebsd' || $^O eq 'dragonfly'); + +# IPC::Manager protocol used as the default for harness IPC. The +# ConnectionUnix driver gives us per-peer SOCK_STREAM connections +# with optional listen sockets, so transient peers (collectors, the +# parent-side spawn handle) can skip listening while services keep +# listen=1 to accept inbound traffic. +use constant IPC_DEFAULT_PROTOCOL => 'IPC::Manager::Client::ConnectionUnix'; + +# Zstd compression level. 3 is Compress::Zstd's library default and +# the same value JSON::Zstd uses when nothing is supplied; we set it +# explicitly so the spec is self-describing and a future tuning +# change is a one-line edit here. +use constant IPC_DEFAULT_ZSTD_LEVEL => 3; use Importer Importer => 'import'; @@ -24,8 +37,56 @@ our @EXPORT_OK = qw{ start_process swap_io list_direct_children + ipc_default_protocol + ipc_default_serializer + ipc_default_spawn_args + ipc_default_connect_args + ipc_zstd_dict_path }; +sub ipc_default_protocol { IPC_DEFAULT_PROTOCOL } + +# Path to the install-shipped zstd compression dictionary +# (share/other/zstd.dict, exposed via File::ShareDir). Returns undef +# when the dictionary is unavailable; the serializer then falls back +# to dictless compression. Both peers must resolve the same path +# with identical content -- File::ShareDir guarantees that for any +# install that ships the share file. +sub ipc_zstd_dict_path { + my $dict = eval { File::ShareDir::dist_file('Test2-Harness2', 'other/zstd.dict') }; + return undef unless defined $dict && -f $dict && -r _; + return $dict; +} + +# Default serializer spec for harness IPC: JSON::Zstd at level 3 +# with the install-shipped dictionary. The ['Class', %args] form +# tells IPC::Manager to construct one configured instance and share +# it across peers (see IPC::Manager::Serializer::JSON::Zstd). +sub ipc_default_serializer { + my $dict = ipc_zstd_dict_path(); + my @args = (level => IPC_DEFAULT_ZSTD_LEVEL); + push @args => (dictionary => $dict) if defined $dict; + return ['JSON::Zstd', @args]; +} + +# Default kwargs for ipcm_spawn(): protocol + serializer. +sub ipc_default_spawn_args { + return ( + protocol => ipc_default_protocol(), + serializer => ipc_default_serializer(), + ); +} + +# Default kwargs for ipcm_connect() from non-services. The +# ConnectionUnix driver builds a listen socket by default so other +# peers can connect back; collectors and the parent-side spawn +# handle never receive inbound traffic and skip the socket. Services +# (Role::Service consumers) keep listen=1 by default so peers can +# reach them. +sub ipc_default_connect_args { + return (listen => 0); +} + sub pid_is_running { my ($pid) = @_; diff --git a/t/AI/unit/Harness2/Util/IPC_defaults.t b/t/AI/unit/Harness2/Util/IPC_defaults.t new file mode 100644 index 000000000..0d474cb74 --- /dev/null +++ b/t/AI/unit/Harness2/Util/IPC_defaults.t @@ -0,0 +1,64 @@ +use Test2::V0; + +use Test2::Harness2::Util::IPC qw{ + ipc_default_protocol + ipc_default_serializer + ipc_default_spawn_args + ipc_default_connect_args + ipc_zstd_dict_path +}; + +subtest 'ipc_default_protocol returns ConnectionUnix class' => sub { + is( + ipc_default_protocol(), + 'IPC::Manager::Client::ConnectionUnix', + 'fully qualified ConnectionUnix class name', + ); +}; + +subtest 'ipc_default_serializer is JSON::Zstd at level 3' => sub { + my $spec = ipc_default_serializer(); + is(ref $spec, 'ARRAY', 'arrayref form so IPC::Manager builds an instance'); + + my ($class, %args) = @$spec; + is($class, 'JSON::Zstd', 'JSON::Zstd serializer'); + is($args{level}, 3, 'level 3'); + + if (defined $args{dictionary}) { + ok(-f $args{dictionary}, "dictionary path is a real file ($args{dictionary})"); + ok(-r _, 'dictionary is readable'); + } + else { + # Acceptable when running uninstalled without ShareDir staging. + is(ipc_zstd_dict_path(), undef, 'no dictionary => helper agrees'); + } +}; + +subtest 'ipc_default_spawn_args bundles protocol and serializer' => sub { + my %args = ipc_default_spawn_args(); + is($args{protocol}, ipc_default_protocol(), 'protocol matches helper'); + is( + $args{serializer}, + ipc_default_serializer(), + 'serializer matches helper', + ); +}; + +subtest 'ipc_default_connect_args turns off listen for non-services' => sub { + my %args = ipc_default_connect_args(); + is($args{listen}, 0, 'listen=0 (collectors and spawn handles do not accept inbound)'); +}; + +subtest 'ipc_zstd_dict_path: undef when share file missing' => sub { + # No way to force the share dir to be missing in-process, so just + # assert the contract: either undef or a readable file path. + my $p = ipc_zstd_dict_path(); + if (defined $p) { + ok(-f $p && -r _, "share-supplied dictionary is readable ($p)"); + } + else { + pass('no installed share dict: helper returned undef'); + } +}; + +done_testing; From 6c4d7a49d41a3c4a86d5b61a6654c23bef5a9fdf Mon Sep 17 00:00:00 2001 From: Chad Granum Date: Sun, 26 Apr 2026 04:21:50 -0700 Subject: [PATCH 07/13] collector + emitter: zstd-compress Atomic::Pipe message frames Atomic::Pipe 0.026 added transparent zstd compression for the write_message / write_burst / get_line_burst_or_data paths in mixed data mode; plain print writes are intentionally left untouched so a pipe can still double as STDOUT/STDERR for an unaware (e.g. non-perl) downstream reader. Adds atomic_pipe_compression_args() and apply_atomic_pipe_compression() helpers in Test2::Harness2::Util::IPC -- the constructor-time form plumbs through Atomic::Pipe->pair, while the post-construction form is needed by the from_fh / from_fd wrappers that do not accept compression kwargs at construction. Both sides resolve the install-shipped dictionary via File::ShareDir (share/other/zstd.dict) and fall back to dictless compression when the share file is unavailable, which keeps the wire symmetric for uninstalled checkouts where every endpoint resolves the same way. Applied at: - Test2::Harness2::Collector::_launch_child (out/err pair) - Test2::Harness2::Collector::_interpose (out/err pair) - Test2::Harness2::Collector::_wrap_handle (from_fh reader) - Test2::Harness2::Util::EventEmitter::_as_atomic_pipe (from_fh writer that promotes STDOUT/STDERR) The collector's reader-side and the emitter's writer-side now use the same level + dictionary, so framed event JSON compresses on write_message and decodes back to plaintext via get_line_burst_or_data. STDOUT/STDERR text from the test child's own print calls passes through uncompressed as before. Co-Authored-By: Claude Opus 4.7 (1M context) --- lib/Test2/Harness2/Collector.pm | 18 +++++++--- lib/Test2/Harness2/Util/EventEmitter.pm | 8 +++++ lib/Test2/Harness2/Util/IPC.pm | 44 +++++++++++++++++++++++++ t/AI/unit/Harness2/Util/IPC_defaults.t | 44 +++++++++++++++++++++++++ 4 files changed, 109 insertions(+), 5 deletions(-) diff --git a/lib/Test2/Harness2/Collector.pm b/lib/Test2/Harness2/Collector.pm index dd203b5cd..adbc6de2c 100644 --- a/lib/Test2/Harness2/Collector.pm +++ b/lib/Test2/Harness2/Collector.pm @@ -21,7 +21,7 @@ use Test2::Harness2::Collector::FileLineReader; use Test2::Harness2::Collector::Handle; use Test2::Harness2::Util qw/load_module parse_exit tinysleep/; use Test2::Harness2::Util::JSON qw/encode_json encode_json_file decode_json/; -use Test2::Harness2::Util::IPC qw/pid_is_running set_procname swap_io ipc_default_connect_args/; +use Test2::Harness2::Util::IPC qw/pid_is_running set_procname swap_io ipc_default_connect_args atomic_pipe_compression_args apply_atomic_pipe_compression/; # This is the base class. Two subclasses add the test-vs-service # divergent behaviour: Test2::Harness2::Collector::Test carries an @@ -1206,8 +1206,11 @@ sub _set_procname { sub _launch_child { my $self = shift; - my ($out_r, $out_w) = Atomic::Pipe->pair(mixed_data_mode => 1); - my ($err_r, $err_w) = Atomic::Pipe->pair(mixed_data_mode => 1); + # zstd compression on both pipes: write_message / write_burst + # frames compress transparently while plain print writes (the + # child's STDOUT/STDERR text stream) pass through uncompressed. + my ($out_r, $out_w) = Atomic::Pipe->pair(mixed_data_mode => 1, atomic_pipe_compression_args()); + my ($err_r, $err_w) = Atomic::Pipe->pair(mixed_data_mode => 1, atomic_pipe_compression_args()); # Save copies of the original STDOUT/STDERR before redirecting; restored # by both platform-specific launchers in the parent path. @@ -1426,9 +1429,14 @@ sub _wrap_handle { return $handle if blessed($handle) && $handle->isa('Atomic::Pipe'); # Pipe or fifo filehandle -- wrap in Atomic::Pipe with mixed_data_mode + # plus the standard zstd-with-dict compression config so framed + # messages from the writer side decode here. from_fh does not + # take extra constructor params, so configure compression + # post-construction via set_compression / set_compression_dictionary_file. if (-p $handle) { my $ap = Atomic::Pipe->from_fh('<&', $handle); $ap->set_mixed_data_mode(); + apply_atomic_pipe_compression($ap); return $ap; } @@ -1784,8 +1792,8 @@ sub interpose { unless Long::Jump::havejump($jump_to); } - ($params{out_r}, $params{out_w}) = Atomic::Pipe->pair(mixed_data_mode => 1); - ($params{err_r}, $params{err_w}) = Atomic::Pipe->pair(mixed_data_mode => 1); + ($params{out_r}, $params{out_w}) = Atomic::Pipe->pair(mixed_data_mode => 1, atomic_pipe_compression_args()); + ($params{err_r}, $params{err_w}) = Atomic::Pipe->pair(mixed_data_mode => 1, atomic_pipe_compression_args()); open($params{orig_stdout}, '>&', \*STDOUT) or croak "Could not clone STDOUT: $!"; open($params{orig_stderr}, '>&', \*STDERR) or croak "Could not clone STDERR: $!"; diff --git a/lib/Test2/Harness2/Util/EventEmitter.pm b/lib/Test2/Harness2/Util/EventEmitter.pm index e79fc1e4c..4c08a10c1 100644 --- a/lib/Test2/Harness2/Util/EventEmitter.pm +++ b/lib/Test2/Harness2/Util/EventEmitter.pm @@ -10,6 +10,7 @@ use Time::HiRes qw/time/; use Atomic::Pipe; use Test2::Util::UUID qw/gen_uuid/; +use Test2::Harness2::Util::IPC qw/apply_atomic_pipe_compression/; use Test2::Harness2::Util::JSON qw/encode_json/; use Object::HashBase qw{ @@ -46,8 +47,15 @@ sub _as_atomic_pipe { return $in if blessed($in) && $in->isa('Atomic::Pipe'); + # Match the collector's reader-side compression config so framed + # write_message / write_burst output decodes on the other end. + # Plain print writes (e.g. the user's STDOUT text) are not + # touched by Atomic::Pipe's compression and reach a non-perl + # downstream untouched. from_fh does not take constructor-time + # compression kwargs, so we configure it post-construction. my $apipe = Atomic::Pipe->from_fh('>&=', $in); $apipe->set_mixed_data_mode(); + apply_atomic_pipe_compression($apipe); return $apipe; } diff --git a/lib/Test2/Harness2/Util/IPC.pm b/lib/Test2/Harness2/Util/IPC.pm index 084eea062..182c8876f 100644 --- a/lib/Test2/Harness2/Util/IPC.pm +++ b/lib/Test2/Harness2/Util/IPC.pm @@ -42,6 +42,8 @@ our @EXPORT_OK = qw{ ipc_default_spawn_args ipc_default_connect_args ipc_zstd_dict_path + atomic_pipe_compression_args + apply_atomic_pipe_compression }; sub ipc_default_protocol { IPC_DEFAULT_PROTOCOL } @@ -87,6 +89,48 @@ sub ipc_default_connect_args { return (listen => 0); } +# Default kwargs for Atomic::Pipe constructors (pair, from_fh, +# from_fd, read_fifo, write_fifo). Enables zstd at level 3 with the +# install-shipped dictionary so write_message / write_burst / +# get_line_burst_or_data traffic compresses transparently. Plain +# print writes (and any byte stream from a non-perl downstream that +# inherits the fd) remain uncompressed -- Atomic::Pipe's compression +# only applies to the framed message and burst paths, so a pipe can +# still double as STDOUT/STDERR for an unaware reader. +# +# Both ends of the pipe must be configured identically; mismatched +# dictionaries silently decode to garbage (raw zstd dictionaries do +# not embed a dict-ID). When the install-shipped dictionary is +# unavailable the helper falls back to dictless compression, which +# is still wire-symmetric as long as every endpoint resolves the +# same way. +sub atomic_pipe_compression_args { + my %args = ( + compression => 'zstd', + compression_level => IPC_DEFAULT_ZSTD_LEVEL, + ); + + my $dict = ipc_zstd_dict_path(); + $args{compression_dictionary_file} = $dict if defined $dict; + + return %args; +} + +# Configure compression on an existing Atomic::Pipe instance to +# match atomic_pipe_compression_args(). Atomic::Pipe::from_fh and +# from_fd do not accept constructor-time compression kwargs, so +# wrappers (e.g. promoting STDOUT or wrapping a child's pipe handle) +# enable compression after construction. Idempotent. +sub apply_atomic_pipe_compression { + my ($pipe) = @_; + return unless $pipe; + $pipe->set_compression('zstd', IPC_DEFAULT_ZSTD_LEVEL); + if (my $dict = ipc_zstd_dict_path()) { + $pipe->set_compression_dictionary_file($dict); + } + return; +} + sub pid_is_running { my ($pid) = @_; diff --git a/t/AI/unit/Harness2/Util/IPC_defaults.t b/t/AI/unit/Harness2/Util/IPC_defaults.t index 0d474cb74..78bda7063 100644 --- a/t/AI/unit/Harness2/Util/IPC_defaults.t +++ b/t/AI/unit/Harness2/Util/IPC_defaults.t @@ -6,8 +6,12 @@ use Test2::Harness2::Util::IPC qw{ ipc_default_spawn_args ipc_default_connect_args ipc_zstd_dict_path + atomic_pipe_compression_args + apply_atomic_pipe_compression }; +use Atomic::Pipe; + subtest 'ipc_default_protocol returns ConnectionUnix class' => sub { is( ipc_default_protocol(), @@ -49,6 +53,46 @@ subtest 'ipc_default_connect_args turns off listen for non-services' => sub { is($args{listen}, 0, 'listen=0 (collectors and spawn handles do not accept inbound)'); }; +subtest 'atomic_pipe_compression_args: zstd at level 3' => sub { + my %args = atomic_pipe_compression_args(); + is($args{compression}, 'zstd', 'compression algo'); + is($args{compression_level}, 3, 'level 3'); + + if (defined $args{compression_dictionary_file}) { + ok(-f $args{compression_dictionary_file}, 'dict path is a real file'); + } + else { + is(ipc_zstd_dict_path(), undef, 'no dict file => helper agrees'); + } +}; + +subtest 'pair() with compression args round-trips a message' => sub { + my ($r, $w) = Atomic::Pipe->pair(mixed_data_mode => 1, atomic_pipe_compression_args()); + is($w->compression, 'zstd', 'writer end has compression on'); + is($r->compression, 'zstd', 'reader end has compression on'); + + $w->write_message('{"hello":"world"}'); + my ($type, $data) = $r->get_line_burst_or_data(); + is($type, 'message', 'reader saw a framed message'); + is($data, '{"hello":"world"}', 'payload decoded back to plaintext'); +}; + +subtest 'apply_atomic_pipe_compression: enables zstd post-construct' => sub { + my ($r, $w) = Atomic::Pipe->pair(mixed_data_mode => 1); + is($w->compression, undef, 'pair starts dict-less'); + + apply_atomic_pipe_compression($w); + apply_atomic_pipe_compression($r); + + is($w->compression, 'zstd', 'writer enabled after apply'); + is($w->compression_level, 3, 'level 3 enabled'); + + $w->write_message('{"k":"v"}'); + my ($type, $data) = $r->get_line_burst_or_data(); + is($type, 'message', 'message frame emerged after enabling compression'); + is($data, '{"k":"v"}', 'roundtrip decode matches'); +}; + subtest 'ipc_zstd_dict_path: undef when share file missing' => sub { # No way to force the share dir to be missing in-process, so just # assert the contract: either undef or a readable file path. From 8c48c111b7d6c161349b3ad9cc1c920924f3eeed Mon Sep 17 00:00:00 2001 From: Chad Granum Date: Sun, 26 Apr 2026 04:49:43 -0700 Subject: [PATCH 08/13] event: cache on-wire compressed JSON frame, write verbatim from JSONL logger Atomic::Pipe's keep_compressed mode exposes the on-wire compressed bytes alongside the decompressed payload from get_line_burst_or_data. Those bytes compress the same plaintext (bare JSON, no inter-record newline) the JSONL.zst logger would produce, so the harness can carry the frame from the collector through the parser and write it to disk verbatim instead of recompressing the same JSON twice. Newline policy: - Atomic::Pipe message frames self-delimit. Producers (EventEmitter, JSONL.zst writer, Util::File::JSONL::Zstd::write) no longer inject a trailing "\n" inside the compressed plaintext. - The plain (non-compressed) JSONL writer keeps "\n" between records since plain jsonl needs it as a separator. - The yath extract command is the canonical place that materializes compressed jsonl as plaintext jsonl; it strips any trailing newlines from each frame's payload and joins with exactly one "\n", appending a trailing "\n" so the file is canonical jsonl. Single-frame .json.zst snapshots pass through unchanged. - Util::Zstd::Reader walks frames via zstd_frame_size in both dict and no-dict modes; readline returns the next frame's decoded payload (no newline assumed). The compression-form unit tests strip leading/trailing whitespace before comparing, since JSON parsers ignore it. Carrying the frame: - Test2::Harness2::Event gains a public compressed_form slot, a clear_compressed_form helper that also drops the +json cache, and TO_JSON now strips compressed_form so the binary bytes do not leak into the JSON encoding. - Collector::_read_handle reads the optional `compressed => $raw` pair from get_line_burst_or_data and threads $raw through _ingest_item / _flush_buffer into IOParser::parse_io's new `compressed` named param, which stashes it on the resulting Event. Auditor invalidation: - Test2::Harness2::Collector::Auditor::Test calls a new _drop_compressed_cache helper at every site that mutates the audited event (subtest_start no_render flag, subtest_end rebuild, the close-by accumulation path, and the head of _subtest_process which mutates facet_data extensively). The helper deletes both compressed_form and the json cache and accepts plain hashref events, since the existing unit tests drive audit_event with hashrefs. Logger fast path: - Test2::Harness2::Collector::Logger::JSONL::log_event checks $event->compressed_form when writing into a Util::Zstd::Writer and forwards the bytes to a new print_raw_frame method that appends them via syswrite without recompressing. Without compressed_form (e.g. harness-internal events that never went through a pipe, or events the auditor cleared) the fallback path runs as before. - Util::Zstd::Writer factors the syswrite into _emit_frame and exposes print_raw_frame for callers that already hold a compressed frame. Co-Authored-By: Claude Opus 4.7 (1M context) --- lib/App/Yath2/Command/extract.pm | 86 +++++++---- lib/Test2/Harness2/Collector.pm | 35 +++-- lib/Test2/Harness2/Collector/Auditor/Test.pm | 25 ++++ lib/Test2/Harness2/Collector/Logger/JSONL.pm | 27 +++- .../Harness2/Collector/Parser/IOParser.pm | 9 ++ lib/Test2/Harness2/Event.pm | 14 ++ lib/Test2/Harness2/Util/EventEmitter.pm | 8 + lib/Test2/Harness2/Util/File/JSONL/Zstd.pm | 11 +- lib/Test2/Harness2/Util/IPC.pm | 7 + lib/Test2/Harness2/Util/Zstd/Reader.pm | 139 ++++++------------ lib/Test2/Harness2/Util/Zstd/Writer.pm | 35 ++++- .../Collector/Logger/JSONL_compressed_form.t | 119 +++++++++++++++ .../Parser/IOParser_compressed_form.t | 67 +++++++++ 13 files changed, 433 insertions(+), 149 deletions(-) create mode 100644 t/AI/unit/Collector/Logger/JSONL_compressed_form.t create mode 100644 t/AI/unit/Collector/Parser/IOParser_compressed_form.t diff --git a/lib/App/Yath2/Command/extract.pm b/lib/App/Yath2/Command/extract.pm index 49d90b4a3..9f852965e 100644 --- a/lib/App/Yath2/Command/extract.pm +++ b/lib/App/Yath2/Command/extract.pm @@ -64,7 +64,7 @@ sub run { my @rest; for my $arg (@$args) { if ($arg eq '--no-decompress') { $no_decompress = 1 } - else { push @rest => $arg } + else { push @rest => $arg } } @$args = @rest; @@ -90,9 +90,10 @@ sub run { my $count = 0; for my $rel ($la->list_files) { - my $is_zst = $rel =~ /\.zst\z/; - my $is_dict = $rel eq 'zstd-dict.bin'; - my $out_rel = ($no_decompress || !$is_zst || $is_dict) + my $is_zst = $rel =~ /\.zst\z/; + my $is_dict = $rel eq 'zstd-dict.bin'; + my $out_rel = + ($no_decompress || !$is_zst || $is_dict) ? $rel : do { (my $r = $rel) =~ s/\.zst\z//; $r }; @@ -115,7 +116,7 @@ sub run { # would still point at non-existent '.zst' paths. Rewrite # the keys to match the extracted shape so consumers # (yath replay, ad-hoc tooling) find the files. - if ($out_rel eq 'artifacts.json' + if ( $out_rel eq 'artifacts.json' || $out_rel =~ m{\Aruns/[^/]+/artifacts\.json\z}) { $bytes = _rewrite_manifest_keys($bytes); @@ -125,7 +126,7 @@ sub run { open(my $out, '>', $abs) or die "open $abs: $!\n"; binmode $out; print $out $bytes; - close $out or die "close $abs: $!\n"; + close $out or die "close $abs: $!\n"; $count++; } @@ -157,37 +158,60 @@ sub _rewrite_manifest_keys { # Decompress a possibly-multi-frame zstd byte string. The single # .json.zst snapshots produce one frame; the .jsonl.zst event -# streams concatenate one-shot frame per line, so the extracted -# plaintext is the concatenation of every frame's decoded payload. +# streams concatenate one self-contained zstd frame per record. # -# Without a dict we feed everything into a streaming Decompressor. -# With a dict the streaming binding does not accept dicts, so we -# walk frames using zstd_frame_size and decompress each with a -# reused DecompressionContext. +# Producers (the JSONL.zst writer, EventEmitter) do NOT embed an +# inter-record newline inside the compressed plaintext -- frames +# self-delimit -- so the extract command is responsible for +# reinserting exactly one newline between records when materializing +# extracted plaintext jsonl. We strip any trailing newlines from +# each frame's payload first so producers that did include one (the +# legacy plain JSONL writer through the same path, or older archives) +# still extract to a single-newline-per-record shape. +# +# Walks frames via zstd_frame_size for both the dict and no-dict +# paths; one frame is one record either way. sub _decompress_multi_frame { my ($bytes, $dict_bytes) = @_; - if ($dict_bytes) { - my $ddict = Compress::Zstd::DecompressionDictionary->new($dict_bytes); - my $dctx = Compress::Zstd::DecompressionContext->new; - my $out = ''; - while (length $bytes) { - my $size = zstd_frame_size($bytes); - die "tar.zidx: incomplete zstd frame in extract payload\n" - unless defined $size; - my $frame = substr($bytes, 0, $size); - substr($bytes, 0, $size) = ''; - my $plain = $dctx->decompress_using_dict($frame, $ddict); - die "tar.zidx: decompress_using_dict failed\n" unless defined $plain; - $out .= $plain; - } - return $out; + my $ddict; + $ddict = Compress::Zstd::DecompressionDictionary->new($dict_bytes) + if defined $dict_bytes; + my $dctx = Compress::Zstd::DecompressionContext->new if $ddict; + + my @records; + while (length $bytes) { + my $size = zstd_frame_size($bytes); + die "tar.zidx: incomplete zstd frame in extract payload\n" + unless defined $size; + my $frame = substr($bytes, 0, $size); + substr($bytes, 0, $size) = ''; + + my $plain = + $ddict + ? $dctx->decompress_using_dict($frame, $ddict) + : Compress::Zstd::decompress($frame); + die "tar.zidx: zstd decompress failed in extract payload\n" + unless defined $plain; + + push @records => $plain; } - my $d = Compress::Zstd::Decompressor->new; - $d->init; - my $out = $d->decompress($bytes); - die "tar.zidx: streaming decompress failed\n" unless defined $out; + return '' unless @records; + + # Single-frame snapshots (.json.zst): return the payload as-is; + # there is no inter-record story to enforce, and a snapshot's + # body may legitimately end without a newline. + return $records[0] if @records == 1; + + # Multi-frame streams (.jsonl.zst): one record per line, exactly + # one newline between records, trailing newline included so the + # file is canonical jsonl. + my $out = ''; + for my $r (@records) { + $r =~ s/\n+\z//; + $out .= $r . "\n"; + } return $out; } diff --git a/lib/Test2/Harness2/Collector.pm b/lib/Test2/Harness2/Collector.pm index adbc6de2c..9674c9832 100644 --- a/lib/Test2/Harness2/Collector.pm +++ b/lib/Test2/Harness2/Collector.pm @@ -1460,15 +1460,22 @@ sub _read_handle { my $self = shift; my ($handle) = @_; - # Atomic::Pipe handles -- return [type, data] tuples so the caller can - # distinguish atomic message bursts (JSON events) from plain lines. + # Atomic::Pipe handles -- return [type, data, $compressed_or_undef] + # tuples so the caller can distinguish atomic message bursts + # (JSON events) from plain lines. With keep_compressed enabled, + # message and burst frames also carry the on-wire compressed + # bytes via a "compressed => $raw" pair on the return list; we + # promote that into the tuple so downstream consumers (event + # parser, zstd logger) can reuse the frame without recompressing. if (blessed($handle) && $handle->isa('Atomic::Pipe')) { my @items; while (1) { - my ($type, $data) = $handle->get_line_burst_or_data(); - last unless defined $type; - push @items => [$type, $data]; + my @res = $handle->get_line_burst_or_data(); + last unless defined $res[0]; + my ($type, $data, @rest) = @res; + my %extra = @rest; + push @items => [$type, $data, $extra{compressed}]; } push @items => undef if $handle->eof(); @@ -1485,7 +1492,7 @@ sub _ingest_item { my $self = shift; my ($buffer, $stream, $item, $merge_outputs, $parser) = @_; - my ($type, $data) = @$item; + my ($type, $data, $compressed) = @$item; my $stamp = time; if ($type eq 'message') { @@ -1502,7 +1509,12 @@ sub _ingest_item { return; } - push @{$buffer->{$stream}} => [$stamp, message => $decoded]; + # Stash $compressed alongside the decoded payload so the + # parser can attach it to the resulting Event for the JSONL + # zstd logger's reuse path. Sync markers on STDERR carry a + # compressed form too but the collector never logs them, so + # the bytes are kept for symmetry only. + push @{$buffer->{$stream}} => [$stamp, message => $decoded, $compressed]; my $event_id = ref($decoded) eq 'HASH' ? $decoded->{event_id} : undef; return unless defined $event_id; @@ -1539,16 +1551,17 @@ sub _flush_buffer { for my $stream (qw/stderr stdout/) { my $queue = $buffer->{$stream}; while (my $entry = shift @$queue) { - my ($stamp, $kind, $val) = @$entry; + my ($stamp, $kind, $val, $compressed) = @$entry; if ($kind eq 'message') { if ($stream eq 'stdout') { # A real event arrived via a burst -- feed it through # the parser so the harness facet still gets populated. my $event = $parser->parse_io( - stream => $stream, - event => $val, - stamp => $stamp, + stream => $stream, + event => $val, + stamp => $stamp, + compressed => $compressed, ); $self->_process_event($event) if $event; } diff --git a/lib/Test2/Harness2/Collector/Auditor/Test.pm b/lib/Test2/Harness2/Collector/Auditor/Test.pm index 89d4bc12c..48d6b7abf 100644 --- a/lib/Test2/Harness2/Collector/Auditor/Test.pm +++ b/lib/Test2/Harness2/Collector/Auditor/Test.pm @@ -193,6 +193,7 @@ sub _audit { my $st = $self->{+SUBTESTS}->{$nested + 1} ||= {}; $st->{event} = $event; $f->{harness_auditor}->{no_render} = 1; + $self->_drop_compressed_cache($event); # Only announce at this auditor's own nesting level -- nested # subtest_start events that slip past the from_tap gate above are @@ -226,6 +227,7 @@ sub _audit { if ($f->{from_tap} && $f->{harness}->{subtest_end} && !($self->{+SUBTESTS} && keys %{$self->{+SUBTESTS}})) { $f->{harness_auditor}->{no_render} = 1; + $self->_drop_compressed_cache($event); my $stamp = $f->{trace}->{stamp} // $f->{stamp} // $f->{harness}->{stamp} // time; @@ -272,6 +274,7 @@ sub _audit { $fd->{parent}->{children} ||= $st->{children}; $fd->{harness}->{closed_by} = $event; $fd->{harness}->{closed_by_eid} = $event->{event_id}; + $self->_drop_compressed_cache($se); my $pn = $n - 1; @@ -305,6 +308,13 @@ sub _subtest_process { my $self = shift; my ($f, $event) = @_; + # _subtest_process mutates $f (== $event->facet_data when an + # event is passed) extensively below: deleting harness.closed_by, + # toggling subtest_closed, pushing errors, etc. Drop the + # collector's cached on-wire compressed frame so a downstream + # zstd-aware logger recompresses against the post-audit body. + $self->_drop_compressed_cache($event) if $event; + my $closer = delete $f->{harness}->{closed_by}; unless ($event) { @@ -487,6 +497,21 @@ sub fail_error_facet_list { return @out; } +# Drop the collector's cached on-wire compressed JSON frame and the +# matching as_json cache from $event. Auditors call this immediately +# before mutating the event body so a downstream zstd-aware logger +# does not write stale bytes that no longer match the post-audit +# event. Tolerates plain hashref events (used by the unit tests) as +# well as blessed Test2::Harness2::Event instances since both are +# hashes underneath. +sub _drop_compressed_cache { + my ($self, $event) = @_; + return unless $event; + delete $event->{compressed_form}; + delete $event->{json}; + return; +} + 1; __END__ diff --git a/lib/Test2/Harness2/Collector/Logger/JSONL.pm b/lib/Test2/Harness2/Collector/Logger/JSONL.pm index d80137b50..cfda52c3c 100644 --- a/lib/Test2/Harness2/Collector/Logger/JSONL.pm +++ b/lib/Test2/Harness2/Collector/Logger/JSONL.pm @@ -54,9 +54,9 @@ sub output_files { # Locate the per-logdir zstd dictionary if one is present. Returns # undef when the run was started dict-less. sub _dict_path { - my $self = shift; + my $self = shift; my $logdir = $self->{+LOGDIR} or return undef; - my $path = "$logdir/zstd-dict.bin"; + my $path = "$logdir/zstd-dict.bin"; return -f $path ? $path : undef; } @@ -104,9 +104,30 @@ sub log_event { # the print operator. Both compress/append-on-print behavior is # identical from the caller's point of view. if (ref($fh) && $fh->isa('Test2::Harness2::Util::Zstd::Writer')) { - $fh->print($event->as_json . "\n"); + # Fast path: the collector caches the on-wire compressed + # JSON frame on the event when it arrived as a JSON burst + # over an Atomic::Pipe configured with the same level + dict + # we use here. The on-wire frame and the JSONL writer's + # frame compress the same plaintext (bare JSON, no trailing + # newline) so the cached bytes can be appended verbatim and + # the extra compress pass is skipped. Auditors that mutate + # the event clear this field, so a present compressed_form + # is authoritative. + # + # Records on disk do not carry an inter-record newline: + # zstd frames self-delimit, and the extract command is + # responsible for inserting exactly one newline between + # records when producing extracted plaintext jsonl. + if (defined(my $frame = $event->compressed_form)) { + $fh->print_raw_frame($frame); + } + else { + $fh->print($event->as_json); + } } else { + # Plain (uncompressed) jsonl: the file format itself relies + # on a newline between records. print $fh $event->as_json, "\n"; } } diff --git a/lib/Test2/Harness2/Collector/Parser/IOParser.pm b/lib/Test2/Harness2/Collector/Parser/IOParser.pm index 2df044d3d..030afd937 100644 --- a/lib/Test2/Harness2/Collector/Parser/IOParser.pm +++ b/lib/Test2/Harness2/Collector/Parser/IOParser.pm @@ -44,6 +44,15 @@ sub parse_io { $self->normalize_event(\%params, $event); + # Stash the on-wire compressed JSON frame the collector captured + # from Atomic::Pipe's keep_compressed read path. The bytes are + # only meaningful for events that came in as a JSON burst and + # whose body has not been mutated since; auditors that modify + # the event clear this field via Event::clear_compressed_form so + # downstream zstd-aware loggers do not write stale frames. + $event->{compressed_form} = $params{compressed} + if defined $params{compressed}; + return $event; } diff --git a/lib/Test2/Harness2/Event.pm b/lib/Test2/Harness2/Event.pm index 7c78bd2f6..46b68db9a 100644 --- a/lib/Test2/Harness2/Event.pm +++ b/lib/Test2/Harness2/Event.pm @@ -13,6 +13,7 @@ use Object::HashBase qw{ {+JSON} //= encode_json($_[0]) } +# Drop the cached on-wire compressed bytes (and the cached JSON +# encoding that pairs with them). Auditors and other consumers that +# mutate the event must call this so a downstream zstd-aware logger +# does not write stale compressed bytes that no longer match the +# (mutated) event body. +sub clear_compressed_form { + my $self = shift; + delete $self->{+COMPRESSED_FORM}; + delete $self->{+JSON}; + return; +} + sub TO_JSON { my $out = {%{$_[0]}}; delete $out->{+JSON}; + delete $out->{+COMPRESSED_FORM}; $out->{+FACET_DATA} = {%{$out->{+FACET_DATA}}} if $out->{+FACET_DATA}; diff --git a/lib/Test2/Harness2/Util/EventEmitter.pm b/lib/Test2/Harness2/Util/EventEmitter.pm index 4c08a10c1..71d1336ef 100644 --- a/lib/Test2/Harness2/Util/EventEmitter.pm +++ b/lib/Test2/Harness2/Util/EventEmitter.pm @@ -115,6 +115,14 @@ sub emit_raw { $event->{event_id} = $event_id; $event->{facet_data}{harness}{event_id} = $event_id; + # Atomic::Pipe message frames self-delimit, so no trailing + # newline is needed on the wire to separate records. The JSONL + # zstd logger writes one frame per event in the same shape, and + # the extract command is responsible for inserting exactly one + # newline between records when materializing extracted plaintext + # jsonl. The collector still caches the on-wire compressed + # bytes on the event so the logger can append them verbatim + # without recompressing. my $json = encode_json($event); $self->{+STDOUT_PIPE}->write_message($json); diff --git a/lib/Test2/Harness2/Util/File/JSONL/Zstd.pm b/lib/Test2/Harness2/Util/File/JSONL/Zstd.pm index 91f477b84..ef6a554be 100644 --- a/lib/Test2/Harness2/Util/File/JSONL/Zstd.pm +++ b/lib/Test2/Harness2/Util/File/JSONL/Zstd.pm @@ -47,7 +47,12 @@ sub write { ($self->{+DICT_PATH} ? (dict_path => $self->{+DICT_PATH}) : ()), ); for my $entry (@_) { - $writer->print($self->encode($entry)); + # Bare json -- zstd frames self-delimit, and the inherited + # encode() would append a "\n" that has no separator role + # under the framed format. The extract command is + # responsible for inserting newlines when producing + # extracted plaintext jsonl. + $writer->print(encode_json($entry)); } $writer->close; @@ -102,7 +107,7 @@ sub poll_with_index { $pos = $end; my $decoded; - my $ok = eval { $decoded = $self->decode($line); 1 }; + my $ok = eval { $decoded = $self->decode($line); 1 }; my $err = $@; unless ($ok) { confess "$self->{+NAME} ($start -> $end): $err" @@ -113,7 +118,7 @@ sub poll_with_index { } my $row = [$start, $end, $decoded]; - push @out => $row; + push @out => $row; push @$buffer => $row if $peek; } diff --git a/lib/Test2/Harness2/Util/IPC.pm b/lib/Test2/Harness2/Util/IPC.pm index 182c8876f..be39b8c7f 100644 --- a/lib/Test2/Harness2/Util/IPC.pm +++ b/lib/Test2/Harness2/Util/IPC.pm @@ -108,6 +108,12 @@ sub atomic_pipe_compression_args { my %args = ( compression => 'zstd', compression_level => IPC_DEFAULT_ZSTD_LEVEL, + # keep_compressed exposes the on-wire compressed bytes + # alongside the decompressed payload from + # get_line_burst_or_data, so the collector can stash the + # compressed frame on the event and a downstream zstd logger + # can write it verbatim instead of recompressing. + keep_compressed => 1, ); my $dict = ipc_zstd_dict_path(); @@ -128,6 +134,7 @@ sub apply_atomic_pipe_compression { if (my $dict = ipc_zstd_dict_path()) { $pipe->set_compression_dictionary_file($dict); } + $pipe->set_keep_compressed(1); return; } diff --git a/lib/Test2/Harness2/Util/Zstd/Reader.pm b/lib/Test2/Harness2/Util/Zstd/Reader.pm index c7aea8e7d..ce9ebcec6 100644 --- a/lib/Test2/Harness2/Util/Zstd/Reader.pm +++ b/lib/Test2/Harness2/Util/Zstd/Reader.pm @@ -7,54 +7,42 @@ our $VERSION = '2.000011'; use Carp qw/croak/; use Compress::Zstd (); -use Compress::Zstd::Decompressor; use Compress::Zstd::DecompressionContext; use Test2::Harness2::Util::Zstd (); # A reader for a multi-frame zstd file produced by # Test2::Harness2::Util::Zstd::Writer (or any other producer that -# emits one self-contained zstd frame per record). +# emits one self-contained zstd frame per record). One frame is one +# record; readline yields the decoded payload of the next frame as +# a "line". # -# Two implementations live behind one interface: -# -# * No-dict path: feed raw bytes through a long-lived -# Compress::Zstd::Decompressor (the streaming binding handles -# concatenated frames natively) and split the decoded output on -# "\n" to yield jsonl lines. -# -# * Dict path: the streaming binding does not accept a dict, so we -# walk the raw bytes one frame at a time. Frame boundaries come -# from Test2::Harness2::Util::Zstd::zstd_frame_size, which parses -# the zstd frame header per RFC 8878. Each isolated frame goes to -# DecompressionContext->decompress_using_dict with a reused -# context and dict instance. +# Both the dict and no-dict paths walk raw bytes one frame at a +# time. Frame boundaries come from +# Test2::Harness2::Util::Zstd::zstd_frame_size, which parses the +# zstd frame header per RFC 8878. The records themselves are not +# required to carry inter-record newlines; producers that omit +# them and consumers that need newline-separated plaintext (the +# extract command, for instance) negotiate that separately. sub _open { my ($class, $path, %opts) = @_; - croak "path is required" unless defined $path; + croak "path is required" unless defined $path; croak "no such file: $path" unless -e $path; open(my $fh, '<', $path) or croak "open '$path': $!"; binmode $fh; my $self = bless { - path => $path, - fh => $fh, - ddict => Test2::Harness2::Util::Zstd::_load_ddict(%opts), - line_buf => '', - raw_buf => '', + path => $path, + fh => $fh, + ddict => Test2::Harness2::Util::Zstd::_load_ddict(%opts), + records => [], + raw_buf => '', + dctx => Compress::Zstd::DecompressionContext->new, } => $class; - if ($self->{ddict}) { - $self->{dctx} = Compress::Zstd::DecompressionContext->new; - } - else { - $self->{decompressor} = Compress::Zstd::Decompressor->new; - $self->{decompressor}->init; - } - return $self; } @@ -80,33 +68,7 @@ sub _read_more { return $n; } -sub _refill_line_buf { - my ($self) = @_; - - if ($self->{ddict}) { - return $self->_refill_with_dict; - } - return $self->_refill_no_dict; -} - -sub _refill_no_dict { - my ($self) = @_; - - my $progress = $self->_read_more; - return 0 unless $progress; - - # Hand the freshly-read raw bytes to the streaming decompressor. - # It returns whatever decoded plaintext is available; partial - # frames are buffered internally so we can call repeatedly. - my $out = $self->{decompressor}->decompress($self->{raw_buf}); - $self->{raw_buf} = ''; - return $progress unless defined $out && length $out; - - $self->{line_buf} .= $out; - return $progress; -} - -sub _refill_with_dict { +sub _refill_records { my ($self) = @_; my $progress = $self->_read_more; @@ -114,19 +76,24 @@ sub _refill_with_dict { my $dctx = $self->{dctx}; my $ddict = $self->{ddict}; - # Walk frames out of raw_buf using zstd_frame_size for exact - # boundaries -- no magic-byte scan. + # Walk complete frames out of raw_buf using zstd_frame_size for + # exact boundaries (no magic-byte scan). Each frame's decoded + # payload becomes one record returned by readline. while (length $self->{raw_buf}) { my $size = Test2::Harness2::Util::Zstd::zstd_frame_size($self->{raw_buf}); last unless defined $size; my $frame = substr($self->{raw_buf}, 0, $size); - my $plain = $dctx->decompress_using_dict($frame, $ddict); - croak "decompress_using_dict failed in '$self->{path}'" + substr($self->{raw_buf}, 0, $size) = ''; + + my $plain = + $ddict + ? $dctx->decompress_using_dict($frame, $ddict) + : Compress::Zstd::decompress($frame); + croak "zstd decompress failed in '$self->{path}'" unless defined $plain; - $self->{line_buf} .= $plain; - substr($self->{raw_buf}, 0, $size) = ''; + push @{$self->{records}} => $plain; } return $progress; @@ -135,29 +102,12 @@ sub _refill_with_dict { sub readline { my ($self) = @_; - while (1) { - my $nl = index($self->{line_buf}, "\n"); - if ($nl >= 0) { - my $line = substr($self->{line_buf}, 0, $nl + 1); - substr($self->{line_buf}, 0, $nl + 1) = ''; - return $line; - } - - # No newline yet; try to pull more bytes off disk. If the - # refill made no progress, we have nothing right now -- yield - # whatever partial line buffer we have (treating it as the - # final unterminated line) or undef. The caller can poll - # again later if a writer is still appending. - my $progress = $self->_refill_line_buf; + while (!@{$self->{records}}) { + my $progress = $self->_refill_records; last unless $progress; } - if (length $self->{line_buf}) { - my $line = $self->{line_buf}; - $self->{line_buf} = ''; - return $line; - } - + return shift @{$self->{records}} if @{$self->{records}}; return undef; } @@ -182,7 +132,7 @@ __END__ =head1 NAME -Test2::Harness2::Util::Zstd::Reader - Line-oriented reader for multi-frame zstd files. +Test2::Harness2::Util::Zstd::Reader - Frame-oriented reader for multi-frame zstd files. =head1 SYNOPSIS @@ -198,12 +148,13 @@ this class is not meant to be instantiated directly. Wraps a multi-frame zstd file (one self-contained frame per record, as produced by L) and yields -decoded lines via L. Without a dict, uses -L's streaming interface (handles -concatenated frames natively). With a dict, walks frames using -C and decompresses -each via L's -C with a reused context. +each frame's decoded payload via L. Frames are +located using C +(RFC 8878 frame-header parser); each frame is decompressed +independently. With a dict, frames go through +L's C +with a reused context; without a dict, through +L. The reader recovers from sticky-EOF state on every refill so writers appending more bytes between reads stay visible to the next readline @@ -213,11 +164,13 @@ call -- usable as a tail-style reader on a live append-safe file. =over 4 -=item $line = $r->readline +=item $record = $r->readline -Returns the next decoded line including its trailing C<"\n">, or -C when no more bytes are available. A partial trailing line -(no terminating newline) is returned once at EOF. +Returns the decoded payload of the next zstd frame (the next +record), or C when no complete frame is available. +Producers control whether records carry trailing newlines: this +reader does not require any inter-record delimiter and does not +add or strip newlines. =item $r->close diff --git a/lib/Test2/Harness2/Util/Zstd/Writer.pm b/lib/Test2/Harness2/Util/Zstd/Writer.pm index e62d39a74..697b73f9f 100644 --- a/lib/Test2/Harness2/Util/Zstd/Writer.pm +++ b/lib/Test2/Harness2/Util/Zstd/Writer.pm @@ -39,13 +39,37 @@ sub _open { } sub print { - my $self = shift; + my $self = shift; my $payload = join '', @_; - my $frame - = $self->{cdict} + my $frame = + $self->{cdict} ? $self->{cctx}->compress_using_dict($payload, $self->{cdict}) : Compress::Zstd::compress($payload, $self->{level}); + return $self->_emit_frame($frame); +} + +sub say { + my $self = shift; + return $self->print(@_, "\n"); +} + +# Append a fully-formed zstd frame to the file without re-compressing. +# Caller is responsible for ensuring the frame was produced with a +# matching level + dictionary so the file's reader can decode it. +# Used by callers that already hold a compressed frame (e.g. the +# collector caches the on-wire frame from Atomic::Pipe and the JSONL +# logger writes it verbatim). +sub print_raw_frame { + my $self = shift; + my ($frame) = @_; + croak "frame is required" unless defined $frame; + return $self->_emit_frame($frame); +} + +sub _emit_frame { + my ($self, $frame) = @_; + my $fh = $self->{fh}; my $len = length $frame; my $sent = syswrite($fh, $frame); @@ -57,11 +81,6 @@ sub print { return 1; } -sub say { - my $self = shift; - return $self->print(@_, "\n"); -} - sub close { my $self = shift; my $fh = delete $self->{fh} or return 1; diff --git a/t/AI/unit/Collector/Logger/JSONL_compressed_form.t b/t/AI/unit/Collector/Logger/JSONL_compressed_form.t new file mode 100644 index 000000000..e5e72fe78 --- /dev/null +++ b/t/AI/unit/Collector/Logger/JSONL_compressed_form.t @@ -0,0 +1,119 @@ +use Test2::V0; + +use Compress::Zstd (); +use File::Temp qw/tempdir/; + +use Test2::Harness2::Event; +use Test2::Harness2::Collector::Logger::JSONL; +use Test2::Harness2::Util::Zstd qw/open_zstd_reader/; + +# Sanity: Event class exposes the new compressed_form slot, holds +# arbitrary bytes verbatim, drops it from the JSON encoding, and +# clear_compressed_form wipes both it and the as_json cache. + +subtest 'Event compressed_form: round-trip' => sub { + my $bytes = "\x00\x01\x02fake-frame"; + my $e = Test2::Harness2::Event->new( + event_id => 'abc', + facet_data => {harness => {kind => 'demo'}}, + compressed_form => $bytes, + ); + is($e->compressed_form, $bytes, 'accessor returns the stored bytes'); + + my $json = $e->as_json; + unlike( + $json, + qr/\Qfake-frame\E/, + 'JSON encoding does not leak compressed_form bytes', + ); + unlike($json, qr/compressed_form/, 'no compressed_form key in JSON'); + + # The cached JSON pairs with the cached frame; clearing the frame + # invalidates the JSON cache so a subsequent mutation gets a + # fresh encoding. + $e->clear_compressed_form; + is($e->compressed_form, undef, 'compressed_form cleared'); + is($e->{json}, undef, 'as_json cache invalidated'); + ok($e->as_json, 'as_json regenerates'); +}; + +# JSONL logger fast-path: if the event has compressed_form bytes the +# logger appends them to the .zst file verbatim instead of running +# the payload through Compress::Zstd a second time. The file must +# still decode back to the same JSON the event would have produced. + +subtest 'JSONL logger writes cached compressed frame verbatim' => sub { + my $dir = tempdir(CLEANUP => 1); + my $path = "$dir/events.jsonl.zst"; + + my $logger = Test2::Harness2::Collector::Logger::JSONL->new( + ipcm_info => 'unused', + output_file => $path, + ); + $logger->startup; + + my $payload = qq[{"event_id":"abc","stamp":1.5,"facet_data":{"harness":{"event_id":"abc"}}}]; + my $frame = Compress::Zstd::compress($payload, 3); + + my $event = Test2::Harness2::Event->new( + event_id => 'abc', + stamp => 1.5, + facet_data => {harness => {event_id => 'abc'}}, + compressed_form => $frame, + ); + + $logger->log_event($event); + $logger->shutdown; + + # Reading back the file decompresses to the same payload. + # Producers may or may not include a trailing newline inside + # the compressed payload; the JSON parser ignores leading and + # trailing whitespace either way, so the test strips it before + # comparing the bytes. + my $reader = open_zstd_reader($path); + my $line = $reader->readline; + s/\A\s+|\s+\z//g for $line; + is( + $line, + '{"event_id":"abc","stamp":1.5,"facet_data":{"harness":{"event_id":"abc"}}}', + 'cached compressed frame round-trips through the file', + ); + + # The on-disk file should be byte-identical to the cached frame + # (no extra recompression or wrapping). + open(my $fh, '<', $path) or die "open $path: $!"; + binmode $fh; + local $/; + my $disk = <$fh>; + close $fh; + is($disk, $frame, 'on-disk bytes equal the cached compressed frame'); +}; + +# Without compressed_form, the logger falls back to compressing the +# event's JSON itself. The output must still decode round-trip. + +subtest 'JSONL logger compresses normally without compressed_form' => sub { + my $dir = tempdir(CLEANUP => 1); + my $path = "$dir/events.jsonl.zst"; + + my $logger = Test2::Harness2::Collector::Logger::JSONL->new( + ipcm_info => 'unused', + output_file => $path, + ); + $logger->startup; + + my $event = Test2::Harness2::Event->new( + event_id => 'def', + stamp => 2.5, + facet_data => {harness => {event_id => 'def'}}, + ); + + $logger->log_event($event); + $logger->shutdown; + + my $reader = open_zstd_reader($path); + my $line = $reader->readline; + like($line, qr/"event_id":"def"/, 'fallback path still writes a decodable frame'); +}; + +done_testing; diff --git a/t/AI/unit/Collector/Parser/IOParser_compressed_form.t b/t/AI/unit/Collector/Parser/IOParser_compressed_form.t new file mode 100644 index 000000000..716da48c2 --- /dev/null +++ b/t/AI/unit/Collector/Parser/IOParser_compressed_form.t @@ -0,0 +1,67 @@ +use Test2::V0; + +use Atomic::Pipe; + +use Test2::Harness2::Collector::Parser::IOParser; +use Test2::Harness2::Util::IPC qw/atomic_pipe_compression_args/; +use Test2::Harness2::Util::JSON qw/encode_json decode_json/; + +# Verify the keep_compressed read path on Atomic::Pipe surfaces the +# on-wire frame, the IOParser accepts a `compressed` named param, and +# the resulting Event carries the bytes verbatim. This matches the +# collector's _read_handle / _ingest_item / _flush_buffer plumbing. + +subtest 'Atomic::Pipe in keep_compressed mode emits compressed bytes' => sub { + my ($r, $w) = Atomic::Pipe->pair(mixed_data_mode => 1, atomic_pipe_compression_args()); + + # No trailing newline -- frames self-delimit on the wire. + my $payload = encode_json({event_id => 'roundtrip', stamp => 0.5}); + $w->write_message($payload); + + my @res = $r->get_line_burst_or_data(); + my ($type, $data, %extra) = @res; + + is($type, 'message', 'message type from compressed burst'); + is($data, $payload, 'decompressed payload matches'); + ok(defined $extra{compressed}, 'compressed bytes are surfaced') + or diag("got tuple: " . join(', ', map { defined $_ ? $_ : 'undef' } @res)); + isnt($extra{compressed}, $data, 'compressed bytes differ from plaintext'); + + my $parser = Test2::Harness2::Collector::Parser::IOParser->new( + ipcm_info => 'unused', + ); + + my $event = $parser->parse_io( + stream => 'stdout', + event => decode_json($data), + stamp => 1.0, + compressed => $extra{compressed}, + ); + + is( + $event->compressed_form, $extra{compressed}, + 'parser stores compressed bytes on the event' + ); +}; + +# A burst with no compressed entry (e.g. came from a non-keep_compressed +# pipe) must not leave a stray compressed_form on the event. + +subtest 'parse_io without compressed leaves event clean' => sub { + my $parser = Test2::Harness2::Collector::Parser::IOParser->new( + ipcm_info => 'unused', + ); + + my $event = $parser->parse_io( + stream => 'stdout', + event => {event_id => 'no-frame'}, + stamp => 1.0, + ); + + is( + $event->compressed_form, undef, + 'compressed_form stays undef when not supplied' + ); +}; + +done_testing; From fbee9556c886943e946293e4b4559a582d1b4f59 Mon Sep 17 00:00:00 2001 From: Chad Granum Date: Sun, 26 Apr 2026 07:11:46 -0700 Subject: [PATCH 09/13] renderer: inherit job_id/run_id onto subtest children render_parent used `$sf->{harness} ||= $f->{harness}` to propagate the parent's harness facet onto each child event. Each child already carries its own harness hash (with event_id only), so the `||=` no-ops and job_id never reaches the child. Result: subtest-internal events render with "RUNNER" attribution instead of the owning job. Replace with explicit per-key `//=` merge of job_id and run_id from the parent harness onto the child. Co-Authored-By: Claude Opus 4.7 (1M context) --- lib/App/Yath2/Renderer/Default.pm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lib/App/Yath2/Renderer/Default.pm b/lib/App/Yath2/Renderer/Default.pm index 58c5b59a9..0958ca121 100644 --- a/lib/App/Yath2/Renderer/Default.pm +++ b/lib/App/Yath2/Renderer/Default.pm @@ -680,8 +680,11 @@ sub render_parent { my $meth = $params{quiet} ? 'build_quiet' : 'build_event'; my @out; + my $ph = $f->{harness} || {}; for my $sf (@{$f->{parent}->{children}}) { - $sf->{harness} ||= $f->{harness}; + my $ch = $sf->{harness} //= {}; + $ch->{job_id} //= $ph->{job_id} if defined $ph->{job_id}; + $ch->{run_id} //= $ph->{run_id} if defined $ph->{run_id}; my $stree = $self->render_tree($sf); push @out => @{$self->$meth($sf, $stree)}; } From e701958777e78ad4c52017f1babeaf87c6254ffc Mon Sep 17 00:00:00 2001 From: Chad Granum Date: Sun, 26 Apr 2026 07:11:55 -0700 Subject: [PATCH 10/13] Tester: reset TMPDIR=/tmp in spawned inner yath When an integration test runs under an outer yath, the outer worker sets TMPDIR to a per-worker subdirectory like /tmp/yath-XXXXXXXX/tmp. Inner yath's IPC::Manager builds its unix-socket route under TMPDIR; sun_path is only 104 bytes on Linux, leaving no room for the 42-byte hashed peer-id under such a deep route. The test child crashes with "Cannot map peer id ... exceeds available budget", the inner harness shuts down, and the renderer fails with "peer 'harness' went away". Reset TMPDIR=/tmp in the spawned child only, so inner yath gets a short route while the parent test process keeps the worker TMPDIR. Co-Authored-By: Claude Opus 4.7 (1M context) --- lib/App/Yath2/Tester.pm | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/lib/App/Yath2/Tester.pm b/lib/App/Yath2/Tester.pm index f5e869726..56d8b261f 100644 --- a/lib/App/Yath2/Tester.pm +++ b/lib/App/Yath2/Tester.pm @@ -139,6 +139,17 @@ sub yath { $ENV{$_} = $env->{$_} for keys %$env; $ENV{YATH_COLOR} = 0; my $pid = start_process \@cmd => sub { + # When this test is itself running under an outer yath, that + # outer worker sets TMPDIR to a per-worker subdirectory like + # /tmp/yath-XXXXXXXX/tmp. The spawned inner yath places its + # IPC::Manager unix-socket route under TMPDIR. The sun_path + # budget on Linux is only 104 bytes, leaving no room for the + # 42-byte hashed peer-id under such a deep route, which makes + # the inner harness fail with "Cannot map peer id ... exceeds + # available budget". Reset TMPDIR to /tmp here in the spawned + # child so the inner yath gets a short route. See + # IPC::Manager::Client::ConnectionUnix::max_on_disk_name_length. + $ENV{TMPDIR} = '/tmp'; return unless $capture; swap_io(\*STDOUT, $wh); swap_io(\*STDERR, $wh); From 080d059d00577285b3f2b40db82bbf3590b4f92f Mon Sep 17 00:00:00 2001 From: Chad Granum Date: Sun, 26 Apr 2026 07:12:27 -0700 Subject: [PATCH 11/13] timing: per-job child_times + Aggregate Job Stats summary The harness_run_end aggregate previously summed per-collector times() deltas as the run's CPU figures. Two problems: 1. The collector's _START_TIMES baseline was captured in init(), before _spawn_collector() forks the collector child. After fork the child's tms_utime/tms_stime/tms_cutime/tms_cstime all reset to 0, so the end - start delta ran negative. 2. Even with the baseline reset, the aggregate represented "collector loop CPU + watched-child CPU" rather than just the watched test process. For users wanting a summary of test-job CPU, that mixes collector overhead in with usr/sys. Reset _START_TIMES at the top of _run_collector so it's captured in the post-fork process. Then add a separate per-job pair of fields covering only the watched child: child_times [usr, sys, cusr, csys] delta from pre-fork to post-waitpid in the parent of the watched child. Captures the whole child tree's CPU via cuser/ csystem, plus collector-loop CPU between fork and reap (kept simple; the full delta is fine). child_wall seconds elapsed from pre-fork to post-waitpid. Reported on harness_process_exit by every collector (including the harness interpose path). Test-job collectors propagate it through harness_job_exit -> test_job_completed -> RunService results so the aggregator picks it up. The harness_run_end facet now exposes: wall_time run service start -> last completed_at (unchanged semantics, relabeled in summary) cumulative_job_time sum of child_wall over completed jobs (would-be-serial wall time) cpu_times/cpu_total sum of child_times over completed jobs cpu_usage cpu_total / wall_time * 100 (cores worth; can exceed 100% with parallelism) Renderer/Summary now formats Run Wall Time, Cumulative Job Time, CPU Time, and the per-component (usr/sys/cusr/csys) values through Test2::Util::Times::render_duration, re-exported via Test2::Harness2::Util. Output: Run Wall Time: 11.5985s Aggregate Job Stats: Cumulative Job Time: 56.8815s CPU Time: 11.9900s (usr: ... | sys: ... | cusr: ... | csys: ...) CPU Usage: 103% t/AI/unit/Harness2/Role/Service.t: stub client() on T::Svc::Fake so run_on_start does not warn about a missing IPC bus. t/Yath/integration/replay.t: extend strip patterns to cover the new Run Wall Time / Aggregate Job Stats lines and use ".*$" for robustness against future duration-format changes. Co-Authored-By: Claude Opus 4.7 (1M context) --- lib/App/Yath2/Renderer/Summary.pm | 45 +++++++++------- lib/App/Yath2/Streamer/Base.pm | 31 ++++++----- lib/Test2/Harness2/Collector.pm | 51 ++++++++++++++++++- lib/Test2/Harness2/Collector/Auditor/Test.pm | 4 +- .../Collector/Observer/TestObserver.pm | 4 +- lib/Test2/Harness2/RunService.pm | 4 +- lib/Test2/Harness2/Util.pm | 2 + t/AI/unit/App/Yath2/Renderer/Summary.t | 4 +- t/AI/unit/Harness2/Role/Service.t | 7 +++ t/Yath/integration/replay.t | 4 +- 10 files changed, 119 insertions(+), 37 deletions(-) diff --git a/lib/App/Yath2/Renderer/Summary.pm b/lib/App/Yath2/Renderer/Summary.pm index c875a0ceb..357a88b51 100644 --- a/lib/App/Yath2/Renderer/Summary.pm +++ b/lib/App/Yath2/Renderer/Summary.pm @@ -3,7 +3,7 @@ use strict; use warnings; use Test2::Util::Table qw/table/; -use Test2::Harness2::Util qw/clean_path/; +use Test2::Harness2::Util qw/clean_path render_duration/; use Test2::Harness2::Util::JSON qw/json_true json_false/; use List::Util qw/max/; @@ -91,14 +91,15 @@ sub render_summary { my $self = shift; my ($run_end) = @_; - my $pass = $run_end->{pass}; - my $pass_count = $run_end->{pass_count} // 0; - my $fail_count = $run_end->{fail_count} // 0; - my $total = $pass_count + $fail_count; - my $wall_time = $run_end->{wall_time}; - my $cpu_times = $run_end->{cpu_times}; - my $cpu_total = $run_end->{cpu_total}; - my $cpu_usage = $run_end->{cpu_usage}; + my $pass = $run_end->{pass}; + my $pass_count = $run_end->{pass_count} // 0; + my $fail_count = $run_end->{fail_count} // 0; + my $total = $pass_count + $fail_count; + my $wall_time = $run_end->{wall_time}; + my $cum_job_time = $run_end->{cumulative_job_time}; + my $cpu_times = $run_end->{cpu_times}; + my $cpu_total = $run_end->{cpu_total}; + my $cpu_usage = $run_end->{cpu_usage}; if (my $rows = $self->{+_FAILED_JOBS}) { if (@$rows) { @@ -114,16 +115,23 @@ sub render_summary { my @summary = ( $fail_count ? (" Fail Count: $fail_count") : (), " File Count: $total", - (defined $wall_time) + (defined $wall_time + ? sprintf(" Run Wall Time: %s", render_duration($wall_time)) + : ()), + (defined $cum_job_time || $cpu_times) ? ( - sprintf(" Wall Time: %.2f seconds", $wall_time), + "Aggregate Job Stats:", + (defined $cum_job_time + ? sprintf(" Cumulative Job Time: %s", render_duration($cum_job_time)) + : ()), ($cpu_times ? ( sprintf( - " CPU Time: %.2f seconds (usr: %.2fs | sys: %.2fs | cusr: %.2fs | csys: %.2fs)", - $cpu_total, @{$cpu_times}[0 .. 3] + " CPU Time: %s (usr: %s | sys: %s | cusr: %s | csys: %s)", + render_duration($cpu_total), + map { render_duration($_) } @{$cpu_times}[0 .. 3] ), - sprintf(" CPU Usage: %i%%", $cpu_usage), + sprintf(" CPU Usage: %i%%", $cpu_usage), ) : () ), @@ -165,10 +173,11 @@ sub write_summary_file { failed => $self->{+_FAILED_JOBS}, - (defined $run_end->{wall_time} ? (wall_time => $run_end->{wall_time}) : ()), - (defined $run_end->{cpu_total} ? (cpu_total => $run_end->{cpu_total}) : ()), - (defined $run_end->{cpu_usage} ? (cpu_usage => $run_end->{cpu_usage}) : ()), - (defined $run_end->{cpu_times} ? (cpu_times => $run_end->{cpu_times}) : ()), + (defined $run_end->{wall_time} ? (wall_time => $run_end->{wall_time}) : ()), + (defined $run_end->{cumulative_job_time} ? (cumulative_job_time => $run_end->{cumulative_job_time}) : ()), + (defined $run_end->{cpu_total} ? (cpu_total => $run_end->{cpu_total}) : ()), + (defined $run_end->{cpu_usage} ? (cpu_usage => $run_end->{cpu_usage}) : ()), + (defined $run_end->{cpu_times} ? (cpu_times => $run_end->{cpu_times}) : ()), ); require Test2::Harness2::Util::File::JSON; diff --git a/lib/App/Yath2/Streamer/Base.pm b/lib/App/Yath2/Streamer/Base.pm index 49ec70dea..f1e67b600 100644 --- a/lib/App/Yath2/Streamer/Base.pm +++ b/lib/App/Yath2/Streamer/Base.pm @@ -328,34 +328,41 @@ sub _harness_run_end_facet { my $results = ref($state->{results}) eq 'HASH' ? $state->{results} : {}; my $all_pass = 1; my ($fail_count, $pass_count) = (0, 0); - my @cpu_agg = (0, 0, 0, 0); - my $have_times = 0; + my @cpu_agg = (0, 0, 0, 0); + my $have_times = 0; + my $cum_job_wall = 0; + my $have_wall = 0; for my $jid (keys %$results) { next unless defined $results->{$jid}{completed_at}; if ($results->{$jid}{pass}) { $pass_count++ } else { $fail_count++; $all_pass = 0 } - if (my $t = $results->{$jid}{times}) { + if (my $t = $results->{$jid}{child_times}) { $cpu_agg[$_] += $t->[$_] for 0 .. 3; $have_times = 1; } + if (defined(my $w = $results->{$jid}{child_wall})) { + $cum_job_wall += $w; + $have_wall = 1; + } } my $stamp = _max_completed_at($results) // time; my $wall_time = defined $state->{created_at} ? ($stamp - $state->{created_at}) : undef; my %timing; + $timing{wall_time} = $wall_time if defined $wall_time; + $timing{cumulative_job_time} = $cum_job_wall if $have_wall; + if ($have_times) { my $cpu_total = $cpu_agg[0] + $cpu_agg[1] + $cpu_agg[2] + $cpu_agg[3]; - %timing = ( - wall_time => $wall_time, - cpu_times => \@cpu_agg, - cpu_total => $cpu_total, - cpu_usage => ($wall_time && $wall_time > 0) ? int($cpu_total / $wall_time * 100) : 0, - ); - } - elsif (defined $wall_time) { - %timing = (wall_time => $wall_time); + $timing{cpu_times} = \@cpu_agg; + $timing{cpu_total} = $cpu_total; + # CPU Usage relative to Run Wall: aggregate CPU-cores worth of + # work performed by all test jobs during the run. With high + # parallelism this can exceed 100% (one core = 100%). + $timing{cpu_usage} + = ($wall_time && $wall_time > 0) ? int($cpu_total / $wall_time * 100) : 0; } return { diff --git a/lib/Test2/Harness2/Collector.pm b/lib/Test2/Harness2/Collector.pm index 9674c9832..ad446d0e2 100644 --- a/lib/Test2/Harness2/Collector.pm +++ b/lib/Test2/Harness2/Collector.pm @@ -67,6 +67,8 @@ use Object::HashBase qw{ +_win32_job +_start_times + +_child_fork_times + +_child_fork_stamp }; # Default auditor accessors for the base class. Test2::Harness2::Collector::Test @@ -582,6 +584,14 @@ sub collect_from_file { sub _run_collector { my $self = shift; + # Reset CPU-time baseline now that we're in the process that will + # actually run the collection loop. _START_TIMES captured during + # init() was taken in whichever process called new(); the unix + # spawn path forks between init() and here, so the original + # baseline reflects the parent's accumulated times and produces + # negative deltas at finalize. + $self->{+_START_TIMES} = [times()]; + my ($child_pid, $out_r, $err_r, $started_child) = $self->_setup_child_handles(); $self->_set_procname($child_pid); @@ -1131,12 +1141,27 @@ sub _finalize_collection { $self->{+CHILD_EXIT} = $child_exit; my $end_times = [times()]; + my $end_stamp = time; my $start_times = $self->{+_START_TIMES}; my @cpu_times = map { $end_times->[$_] - $start_times->[$_] } 0 .. 3; my $px = parse_exit($child_exit); $px->{times} = \@cpu_times; + # Per-job child-process times: baseline taken just before the + # collected child was forked, end taken now (after waitpid), + # so cuser/csys captures the full child tree's CPU and the + # delta wall-clock spans the child's lifetime. Reported + # whether or not this collector is a test-job collector; + # only test-job collectors aggregate it (TestObserver + + # RunService + harness_run_end). + if (my $cf = $self->{+_CHILD_FORK_TIMES}) { + $px->{child_times} = [map { $end_times->[$_] - $cf->[$_] } 0 .. 3]; + } + if (defined(my $cs = $self->{+_CHILD_FORK_STAMP})) { + $px->{child_wall} = $end_stamp - $cs; + } + my $exit_event = Test2::Harness2::Event->new( event_id => gen_uuid(), stamp => time, @@ -1249,6 +1274,13 @@ sub _launch_child_unix { my $cmd = $self->{+LAUNCH}; + # Baseline for the per-job (child-process) times reported on + # harness_process_exit. Captured pre-fork so the delta covers the + # entire watched-child tree (its CPU rolls into our cuser/csys at + # waitpid) plus any collector-loop CPU between fork and reap. + $self->{+_CHILD_FORK_TIMES} = [times()]; + $self->{+_CHILD_FORK_STAMP} = time; + my $pid = fork() // die "Failed to fork child process: $!"; if (!$pid) { @@ -1333,6 +1365,10 @@ sub _launch_child_win32 { STDOUT->autoflush(1); STDERR->autoflush(1); + # Baseline for child_times/child_wall. See _launch_child_unix. + $self->{+_CHILD_FORK_TIMES} = [times()]; + $self->{+_CHILD_FORK_STAMP} = time; + my $pid; my $ok; { @@ -1378,6 +1414,10 @@ sub _launch_child_win32_job { # local-env by temporarily setting the vars before spawning. local @ENV{keys %env} = values %env; + # Baseline for child_times/child_wall. See _launch_child_unix. + $self->{+_CHILD_FORK_TIMES} = [times()]; + $self->{+_CHILD_FORK_STAMP} = time; + # Pass the pipe write ends as the child's stdout/stderr. # Win32::Job->spawn accepts filehandles for stdin/stdout/stderr and # marks them inheritable before calling CreateProcess. @@ -1811,11 +1851,20 @@ sub interpose { open($params{orig_stdout}, '>&', \*STDOUT) or croak "Could not clone STDOUT: $!"; open($params{orig_stderr}, '>&', \*STDERR) or croak "Could not clone STDERR: $!"; + # Baseline for child_times/child_wall in the interpose path. The + # parent of this fork becomes the collector; the child continues + # as the watched process. Capture pre-fork so the post-waitpid + # delta covers the child's whole lifetime. + my @child_fork_times = times(); + my $child_fork_stamp = time; + my $pid = fork() // die "Failed to fork for interpose: $!"; # Parent becomes the collector and exits when done -- does not return if ($pid) { - $params{pid} = $pid; + $params{pid} = $pid; + $params{_child_fork_times} = \@child_fork_times; + $params{_child_fork_stamp} = $child_fork_stamp; $class->_interpose_parent(\%params); } diff --git a/lib/Test2/Harness2/Collector/Auditor/Test.pm b/lib/Test2/Harness2/Collector/Auditor/Test.pm index 48d6b7abf..e432a7456 100644 --- a/lib/Test2/Harness2/Collector/Auditor/Test.pm +++ b/lib/Test2/Harness2/Collector/Auditor/Test.pm @@ -413,7 +413,9 @@ sub _subtest_process { exit => $px->{all}, codes => $px, stamp => $event->{stamp} // $f->{harness}->{stamp} // time, - (defined $px->{times} ? (times => $px->{times}) : ()), + (defined $px->{times} ? (times => $px->{times}) : ()), + (defined $px->{child_times} ? (child_times => $px->{child_times}) : ()), + (defined $px->{child_wall} ? (child_wall => $px->{child_wall}) : ()), }; push @{$f->{errors}} => $self->fail_error_facet_list; diff --git a/lib/Test2/Harness2/Collector/Observer/TestObserver.pm b/lib/Test2/Harness2/Collector/Observer/TestObserver.pm index 6c4eb074d..a144acb6d 100644 --- a/lib/Test2/Harness2/Collector/Observer/TestObserver.pm +++ b/lib/Test2/Harness2/Collector/Observer/TestObserver.pm @@ -228,7 +228,9 @@ sub _emit_completed { $payload{fail_count} = $auditor->fail_count if $auditor->can('fail_count'); } - $payload{times} = $exit_facet->{times} if $exit_facet->{times}; + $payload{times} = $exit_facet->{times} if $exit_facet->{times}; + $payload{child_times} = $exit_facet->{child_times} if $exit_facet->{child_times}; + $payload{child_wall} = $exit_facet->{child_wall} if defined $exit_facet->{child_wall}; $self->_send_to_run(\%payload); diff --git a/lib/Test2/Harness2/RunService.pm b/lib/Test2/Harness2/RunService.pm index bbe1f15ab..c1690d8e4 100644 --- a/lib/Test2/Harness2/RunService.pm +++ b/lib/Test2/Harness2/RunService.pm @@ -554,7 +554,9 @@ sub _handle_test_job_completed { $r->{codes} = $content->{codes}; $r->{pass_count} = $content->{pass_count}; $r->{fail_count} = $content->{fail_count}; - $r->{times} = $content->{times} if $content->{times}; + $r->{times} = $content->{times} if $content->{times}; + $r->{child_times} = $content->{child_times} if $content->{child_times}; + $r->{child_wall} = $content->{child_wall} if defined $content->{child_wall}; $r->{stamp} = $completed_at; $r->{completed_at} = $completed_at; diff --git a/lib/Test2/Harness2/Util.pm b/lib/Test2/Harness2/Util.pm index e96105211..88be08bde 100644 --- a/lib/Test2/Harness2/Util.pm +++ b/lib/Test2/Harness2/Util.pm @@ -29,6 +29,7 @@ our @EXPORT_OK = qw{ open_file parse_exit read_file + render_duration render_status_data tinysleep unlock_file @@ -244,6 +245,7 @@ sub parse_exit { }; } + # Compression readers recognised by open_file(). Only used on read; writes # go through plain open() regardless of extension. my %COMPRESSION = ( diff --git a/t/AI/unit/App/Yath2/Renderer/Summary.t b/t/AI/unit/App/Yath2/Renderer/Summary.t index 48f352055..f80ff7f2f 100644 --- a/t/AI/unit/App/Yath2/Renderer/Summary.t +++ b/t/AI/unit/App/Yath2/Renderer/Summary.t @@ -79,10 +79,10 @@ subtest 'render_summary shows timing when present' => sub { }); close STDOUT; open(STDOUT, '>&', \*STDERR); - like($buf, qr/Wall Time.*10\.50 seconds/, 'wall time shown'); + like($buf, qr/Wall Time.*10\.5000s/, 'wall time shown'); like($buf, qr/CPU Time/, 'cpu time shown'); like($buf, qr/CPU Usage.*71%/, 'cpu usage shown'); - like($buf, qr/usr:.*2\.10/, 'user time shown'); + like($buf, qr/usr:.*2\.10000s/, 'user time shown'); }; subtest 'render_summary prints fail result' => sub { diff --git a/t/AI/unit/Harness2/Role/Service.t b/t/AI/unit/Harness2/Role/Service.t index 3735a1d5d..70175ad7b 100644 --- a/t/AI/unit/Harness2/Role/Service.t +++ b/t/AI/unit/Harness2/Role/Service.t @@ -71,6 +71,13 @@ use Test2::Harness2::Role::Service; push @{$self->{+CALLS}} => "on_reaped:$pid"; return; } + + # The role's run_on_start eagerly calls $self->client to register + # on the IPC bus. With no real ipcm_info plumbed in, the default + # implementation tries to read stats files off disk and warns + # "Failed to initialise IPC client in run_on_start: malformed JSON + # ...". Stub it out so unit tests don't depend on a live bus. + sub client { return undef } } subtest 'IPC::Manager::Role::Service contract defaults' => sub { diff --git a/t/Yath/integration/replay.t b/t/Yath/integration/replay.t index 45ebf5f43..030d2e071 100644 --- a/t/Yath/integration/replay.t +++ b/t/Yath/integration/replay.t @@ -19,7 +19,9 @@ sub clean_output { $out->{output} =~ s/^.*Wrote archive:.*$//m; $out->{output} =~ s/^.*Symlinked to:.*$//m; $out->{output} =~ s/^.*Linked log file:.*$//m; - $out->{output} =~ s/^\s*Wall Time:.*seconds//m; + $out->{output} =~ s/^\s*(?:Run\s+)?Wall Time:.*$//m; + $out->{output} =~ s/^\s*Cumulative Job Time:.*$//m; + $out->{output} =~ s/^\s*Aggregate Job Stats:\s*$//m; $out->{output} =~ s/^\s*CPU Time:.*s\)//m; $out->{output} =~ s/^\s*CPU Usage:.*%//m; $out->{output} =~ s/^\s*-+$//m; From 101115ac03f3e4e83cd99beccf0c5e70aa2d08d5 Mon Sep 17 00:00:00 2001 From: Andy Baugh Date: Sun, 26 Apr 2026 07:35:00 -0500 Subject: [PATCH 12/13] replay.t: add event-coverage scenario using committed all_events archive Adds a second yath replay scenario that replays a pre-committed archive generated from a fixture exercising all common renderer event types (PASS, FAIL, PLAN, NOTE, DIAG, TODO, SKIP, ! PASS !, REASON, FAILED). The replay runs with -v to enable verbose output, then checks a %seen hash to assert every expected tag appears at least once. No golden comparison -- ordering is irrelevant; only presence matters. Co-Authored-By: Claude Sonnet 4.6 --- t/Yath/integration/replay.t | 25 ++++++++++++++++++++++ t/Yath/integration/replay/all_events.tx | 21 ++++++++++++++++++ t/Yath/integration/replay/all_events.yath | Bin 0 -> 21024 bytes 3 files changed, 46 insertions(+) create mode 100644 t/Yath/integration/replay/all_events.tx create mode 100644 t/Yath/integration/replay/all_events.yath diff --git a/t/Yath/integration/replay.t b/t/Yath/integration/replay.t index 030d2e071..1888f4ca7 100644 --- a/t/Yath/integration/replay.t +++ b/t/Yath/integration/replay.t @@ -82,4 +82,29 @@ yath( }, ); +my $all_events_archive = File::Spec->catfile($dir, 'all_events.yath'); + +yath( + command => 'replay', + args => [$all_events_archive, '-v'], + exit => T(), + test => sub { + my $out = shift; + + my %seen; + for my $line (split /\n/, $out->{output}) { + if ($line =~ /^[\(\[\{<](.*?)[\)\]\}>]/) { + my $tag = $1; + $tag =~ s/^\s+|\s+$//g; + $seen{$tag}++; + } + } + + for my $tag (qw/ PASS FAIL PLAN NOTE DIAG TODO SKIP REASON FAILED /) { + ok($seen{$tag}, "saw event type '$tag'"); + } + ok($seen{'! PASS !'}, "saw amnestied assertion '! PASS !'"); + }, +); + done_testing; diff --git a/t/Yath/integration/replay/all_events.tx b/t/Yath/integration/replay/all_events.tx new file mode 100644 index 000000000..0198f965e --- /dev/null +++ b/t/Yath/integration/replay/all_events.tx @@ -0,0 +1,21 @@ +use Test2::V0; + +plan 4; + +note 'this is a note'; +diag 'this is a diagnostic'; + +ok 1, 'passing assertion'; + +todo 'expected failure' => sub { + ok 0, 'todo failure'; +}; + +SKIP: { + skip 'skip reason', 1; + ok 1, 'this is never run'; +} + +ok 0, 'real failure'; + +done_testing; diff --git a/t/Yath/integration/replay/all_events.yath b/t/Yath/integration/replay/all_events.yath new file mode 100644 index 0000000000000000000000000000000000000000..93f152d7cd8b37ba4ef86c580f333609e4483ebf GIT binary patch literal 21024 zcmeHuXH-;emhP#dfFeT?ETRRHb3u`Vbo6+54_LcaXOa z@DJa3uQx#y3i$1Kz5V%-7m4BpkOD{{eiSdCkPs5!Me+$#A2MInPEXxrm44JNd9x|?I?hG5x zjW~B_$YT$kX8Ke)kr0C+gR2*Jom@=6k6cWe* zyc`lGz%L^3cksh+(D)1Zzec;@pW$DSmmm2D{{I&J{k`}6hJVZN*yZGa0gVwO;^_`( z-IpibZoDvLf_uegkP)V^0`r%uuMI!inq($HXG5k80hQ~0axDyB{DEvQzS;xeG(gI} zTm$0@V3$l#rK0a+RzfNh%I4CkTO&vZENQ@mFNK{z$U}Mw#MC;?u`7FzJZ^MGY<@!i zR(>!s0p#0#vY&iW_+e5soFIZGjvrAEH7_(RKCo;G5^(TTjPGBla{QpA9<7x=C78}l z)}Q`PV5;skXE@J2U-icEP<$7LqBReLT{ z%=P#Jxrtd(-*?o>qx?0faht!i`L%&+=)-2);3Z0?*S9*1vS;oT-g9eN>sFDcQxM4^ z=wUWBm{yXA&+x^Hd1Yl`LMFhndR{OhA5k`{FTL7z!=-sO-IK+YgsU*pCeWB*zTX3; z?=zYuFRzvUD%*M3_Wn-SZ6y~mU4wBY^)5K0Q>0>8qdWRRWf+@HJQ{bHI0euG13L0E z7_g!fltLJpyv~qFL^cEKhO}7)l3#AV;f3L_MT8Ucca1mL6vHx9k+K3N@3=wa4)hII z-!@lEm>rvJ=!nYkI8IVs+`}_sMH^hVb)VVF4}_NU*Q?536~-a0veG~upIi0hzjFX2 zM|#4Bs-c`8upFn)*(MxEW6iIG?LQXYP((MaGVx0+PufqK-Sv#vG*$9D3-Hnmef&t2 zRIax{M(YJ4RS*Xj-P1|GIX`{$KKz-lnsrF72q%j*Ho5oN5iCPV$o5&P*dXfT#~(yF z#oq2kZt$nVEkvLqm1;I&3+FnDA0=4kBO`rcxZ`o79)~-D&m9_Tmf#|}et#8LJ;KmLIqKDPcX&!1sf>usMto<*=1Sp*$S0*ycO7V6fz91FWs7GOGt@R)w2 z!Nn`Of)R|r*ZTi>{y)e6uK%S4;$P-}B(IR*zvF*Ckw_QY;RD6W{ zG#LIF3>v=O0QvE#w`Fpy?V-1u2-aet>kUX98_MM=rkL)SnKMggl209cI*6qN&+@f6 zE%S6As_Elh6b6?M(OWzyZgBcR#O(aqBB zUu^H5xu;GO6O_K;#Z`1tQj;;}gll+`bY@b@5^glj&}}=hW^73_l3}h3mopKodnP#c z#!^M!)P+g9Mfu%zwi!%+`RNvB_haa)@_C4BY$sXG$$B++j`?!x#YA=Sl(pb?dGghs z&oD8U{n)xfWv1cuE6gJ{`s2=@+Cf!g_Zz*Vkih zj5KFqH&sMU1||0K`eQd^-`tJJNl~^Yw>q9q|A6G1vO9F!5PCDLjQ(I!PM%w;2X_{p zyz5K;c2xZ%b}V}plV*Z4D_WSzElcV4L)Ei-%RoZl21Eq^?f2$NIm;P_8_LxeAp(M3 zve@#bef!UeVtShzhQOZrKS)LZeceUKY2i7ze%~2n7I{h_U)pSWkqyBA-nnawyx9+1-9EXWjtY zoSXnuC->6shEJ$-<-MQ@rCZ8VTWZTHRdA}eFzpI$kGRdQ*oPcOHU*}S^%kc!3ZU^^ z;KRy>k3;(wDr&KJfls@M$0==44WL28CtqawRs><`-S~;6Fi-cThz7T3-RB}wYLd4N zCX6>Y_A5qR8E+_=$LSqSE>uz76!jWMvXkSTyxtycQvl%#L(5t!zR}0cBtHC7K?Fq8 zLww$Ub@<6bMtZb@M*T9X0#FhT5Unl7h^TU$Lnl-5sgjhD5(f9GS`U(g@!8Lt40|Z( zC1h|wlRyQC8$e#~6Vql2IkB(L{7Z8i%5j_Ky$iju{BH{nEx&JNsA%lc8#T*4fTEaSj_j{(61|BMgav&X7A8x3Xt za2vQ0nG~Vf_iWGWJsF2$Y|4j-$#s}B-K{yow9i{+qXw=fX0bJ}T=Qmjc;7op9ymVe z2C$dH8d>j-SFc>lLD6N;|9mJ&_+m;Pxz<8V!iu|jvEO19i&P_}z@mv7#52wG8$y(~ zy1SOZwiqV#Nb|VVe~B&xIKTu-RGDvTDep^H-s)h;G!vAb#Nv;*P|)erO5EY96JX}| zB@K$IY#yv3N#(QQf{NL}_hx-t^;N%7xR1sX3)H*EgO-*pHxKW#_5m77x@G$}I82Ol z)0`AnSYFx1=H>;-%%ywJu9TuF7PxK-R%GC3T@`*`35R{i;>ny_VHXwiLUZIg9tjs-Mco1yN~?KOy4il#w$3pXzw`L))0*cw{eE#*xX;I#~++1^ZzI=%Yij=_`h8qtXiSXbSQJcr$GWIT8rrD6Yc{S>u$XUAL zva&ZzY)w-YNgPr^A!Hr?-ko-`w)@i8n2p6(k6NeFiV0;O9SsH(6JuSoi#3_s1$fhCPPg$h_jM z793u5F}B4ECwTKr3;Q(VY=eeWOK_FL$TmdMHa5!`z2w>W&DPGZt58q80iQXsC*H}@ zHqKh=)0#7r67$CEOXc`SGCQf(*^~!Z8pDs&rJk9-4?1W5kiq>vZeCO4k-yAQOlXnm z3nkgzGpf!FEf0fuL+HZgmqZWtgd4)ky$WpsVPHwOARWGA?5-VEQ+ z#hKu~%j}wsO}LGN85`Kiqi)l!f}omwILE~}@F zWzXLT;3?Tt%AFZxQ8vm;)Ir~r34C4a%ni_YuddEes%G@wHXx>9Us?d8AZpfj-l}^phm+bsiKFUUZ^!Pyc zSfqp?IEi_`3a1T%l*7WVG*XmT@WvYw92>NhR+R?*3wd5o=S1~-I!>ojS%;4zU2XM$ z+C=hAFZkc>YEsrGukU5yZ^n^`u5hCI9AMQhzL=Z5^t!TZ)AbpFBO{q95z$vL@{aO@3iSG70X|QHqX%A9@UJ!d5hi4tt91`fdH_9^av&h8sQN> zEq>XvO-V8xI^c_5dE{=DQso@h4&j8evi_RRIba6`PLlZ$Qp$E>9C~lv7BUm#qIcG4 zju>lbO5o9-3|}`^$D>gU*Na1BegH*zd*XOYSiVE=7fa^_c+^kCLrlH&md7y0T`Xh% z8S!e(Y|%-@jEreEY=Zn)vXbwJV|^^Ti1S*lE}WM8mvaz9=i4SE9Zt^Q;%Vhu%q=^G zUUY||y}iHjX9iLzHwZt$>?H2k8fBg5CV#UMi-MWdeI*jKQ~UDv-VRxxiLQo>$m*p5 zUkkM5O5*(Ppgs3ni=KWXtnH;wQQq!@(fPUM7En0A2cdH8!HD`=+A%?0lr2!|2GNM# zsp2B5hVZODcp}|;`rVGga%x{f4Ok{7oY4b`>YFGknK!WG;zI(&e4b{Hvc#S3x z$b)w^zaO{ig?(q#>guqAcZEFf=kOhV{bSi|AM<++Q%ouYw!DsY94u->3TF-7LpA%s zs>;{;r*CHo5B02+40G`K0)Zqx8D-(4w39~<9=jjNsS$7126@}~rCXaptj#39NxjVE z+csulvkU(z_q2Zn{orcm=|_Y8%%)ju73E>McC((Nw!FMdLEDNitG6FNCdqnKijR>rl7 zayuj@U>!5_aNo!7<7;xMtL@)qEX9W@&Ai7)o{PU;tIIQJ-Et}f1vNhr6QHOMvU{1~ z`;@vA(Xy!OYh#;}#yL72<8?(|>uyo0T`mKqhfyJ*G6)3_AQPU!zK#Kt@)a474wsW* z0?DVP-qX<{$Da87@^W}#Dh@7c@4ZUbry;!2e!@=W9MXRBn8L(-UzTdgLtURX1$;vO zL83=MqoD0ua^c1CK92bFax~Y2<&pid5>v2C=~;?{Yc+E;j^7|C_Xkm1tyaF8v-H}h z)t@#)?x|eEOlQRz&~{8^i2#ylmLo?Dg$LuDx?w`Armc#%jrIfsU2J{4t8Ak*a-Y@N znuIA(rP_GT++gQ)kFsd~|>qJfkx@V@sqZ7x?mOQ`tmSHxAu z|JMx5?VC*m&rJ_9&C%CX%r$gBk#yGwE6kJnje<7RM ztWj;k$rlM z^f|lbi8Bh2Fk1?edt?g@0H%>~5kM z#myQDo0lsl8Q(7(W>dRbKivBIvM7z3^>o@s$4TBroHk#2^DAK-^|9Rk=g1?XsEs(E zk#IL&VFmmBY|cU+ZnTy@HvcnRus!)N)0G7_F#&6Q)?dFRR*C8e_cj_PD5riDxLaS) z+Ld0@-9^p*BlG7d*7%IL*WTG)anV>H`CSxN?q|o+tJCf3PP?etmgbO7wyn{f4FT*6 z$*4uqtnZTiG!P}yTe-lv{0A+Boex5(2uE%;a*VGOMCfRu!iN5NyY1qq!e>N#7+O^_#cnee>qe9m*aoDynOup|2F@_cm2d4@xOmw{O=4%f&kXBw6vC0 zbQkcEB+NSh-j(EeAhl$YF>m$i2Q^O^>z3uy`ZZGqv6xbh7rc@V#n?}HI2g3if(SCm zvYy6t#`E23sIvBS$HP$LH?l>hRXhYq0xoAa6a{X3id)d7_po|SHfa02e%^0SZNDNo zK`7!mY>2x6w@Dzu21MpbOR}LfDSTby3sfY!NlF@J4!nP2r2iC2{Qvopza9TRcHTb! zE>$ceEyE=&pdiO3!Y8XBBFrnIz%QWi=c(eqhJOLn_21~9)_?Hv^9k|)k^lW?SmZB% zMh+gt1r)Re7_{Q10YpFR2p;P}t}4Ul{TwVTD5qgM337)| z5~TQitVi~_eQyKnm;(Vpro7V+X_ZXIWn?LzzxsCWdw(`%7zU$@+p8^vf`D~$%WG;% zMLds2j_-Qf5?a)EV zb~s3$oPKx5vAcoCnF80H`JEMBO0Gn7tW_~Odjd10?onMr-kt7pju+;qd^WO+)Gsrc zjJWq}^(C>NmA%TL;}SwxG6?(HKTHgA2|Iv$j8ieX1iYv=yxEAecxH`bAf6Ci0cKb) z%eSiS&B)`(VafN4ee=OgQAz0ylk4N;aI9F_mcTAy?sYGNFj^h+KHfMWiH)!=*0il| zajcZU3de^Ri%*z99I)bKb>Q)cArnSzOy#(hvJDRjmFI_RT}PV!H*f!K`2Uks;a|o- z^4k4h$Grb7{!u8wKk)z0u$y1_9|tAj1DSK`Oo#+gV5}|ojsUG$&B20X2;i_h<}@5- zS@g`K-8FcqS`?50#1#PP>x0IozJ;gm(4obn24c-}lLAV4J5iI=A%EU2LPn z+aVcF%Q+wI)ch=`$sd2wSHF5@giOC&x$%%&KLT#0YY-sbS?!jo!4%K1)5{tU7Go>) zJ6~3a>u#7g5?n6!I1YGW`|S|_%jo6;TSum{U=rIX$4%k>@O6? zKoSqs7#rj)%(D(hKH(Nq2#oipv8lM2y`O}xh<&z==+<;}YqS}ymW8c2$UY?ud~Xr+ z_S$mq_i@qf7$YzH z%%|Bjm_6{c>J7&DZWQIzD7Hj3Gv@*M*gLnk{{A6e7?D{SmLV|DPT5z$2o;D= z?G!Th#$3rG?#FL>!|&6RfiNq#vKrEf%YMgkbLoxF6N^Z81ONu`WrMICM#9nrpOsmq z3u-AcSiI>wu8OKUUn4ESVur?>WM6uW&$Pbd8Vq%3w#y9+n6H0RdP@Kzp+*ZcMhA7W z*Cf!iIFP6Oke_LYmO6D~>5nZ6r#nQxvBkTS(m~vn^K2u>a?niQ$dKrlne~Am5&-t| z8cf7bMFG^kg6|En0FOdQ%N@7StQ;*!Po+*1=0c_>MB!RdQg39h?Oh2tAUyZmSuGB9 ztdMK;aQD=G;CircxYQ~nBVZcbDR6})o!p0$!pP=Kr<_LPKWa;Un5w9r=`h_o)M@jO z;$1r1vLTpE<*Uabf%DxRU?G(C-g9uMpz%ft}jScMNM*5Q+f_g_SulJgAGSnM14htDXF_9YWz7*TFtY;cd$iZX?ye z;DNj5cFoNu8DGwyP%QO2>T?`wO+1(iim>$;C&WMGo|m*H`Aomle|bpO<@P|yc`((G zYzc!C!3(xb3W?>q_b-ua09G^b^*w4LWI_SJ}+l4((3Z zeG!uwNP??=S80Jz`?bVH>yM^)QoOE$QaI=cX%43Jub80VpRa75bl#Kc-?E;y3+Hy6 zZ%MK{4=8r3Uq;lg8#&PZ(%mq)fB?Xv(qcl?2!bG_(Y6I{4>cFknECEQq%)S!;;d?( zILu9ct6RrKV`O6~1G3lq>&;8d4J+{y%)kX~_4U zE9MMFTI119Zb$lKNOd#9p?)T4jwjPC(D!n|@-ZsTPNYSg`C-QQHJw?dvpP+0hUUy; z^+nb=_2JBvq>qiNvn@GZSG`hw>-*E^NP_*klZEEKIx+Y+>0S8wLAg?Hd5u{??5Z$0 zg{}mnY@pqZVa8lokf>!v*t2^^s}o;c2pTW1YT)=>onXU#4qUZ$IXiQLbv`^%!|3VG zy?e=$?#cJKjp=r#;JE;xPhNGI9)~c`%~$(qG9K6&@zZh)UGUg9<$Q`%zYdp1eHz?et{b%w@)5^*@G%u7yIjv;CQk3VqGNM*_@YasyjKO= zfyAVIN5Xo$k2*Uk3)x@jn!D02OnpjKprP zfOJpccfPU2hFcN`twwSQ!$V?|43V#7a!A8S05n+-;x-_6&5&f)i)zOD*6eBZB2-7$ zhUpcwem}UXGH~Hzjb~h#e2>U1E6(=PNg>i;w{@$ak74M<^|IxKf3;V95MTK>g#)~( zFN7J7=B$GDcxOT*OeV?APDMDSwSPRYc^@BR} zNGtGz`&SE8&YqkdjGhFr5^Y+MIf&c_2wy(hRd>SV_cMs+e<2X35D0(lS+Lxda-Y_Ng;a*o&tZQ1}m|J#D4mjnsMIO`1|x&-DvzBD(!2W?&ZQq!POoz=ek_FnVMRNyH5Z0gzF zkD<{K6iV-yj|A^YedEJ!2itp2z&AF}K(kbmKkheUFsJwxH*$!-DzK4hTq6CYuQMz4b`IUd;u|z-} zzl{uA!Z%Fm%U>>OxeS*)3FeSLQdhQ(vsIYT5DA`!5V#sois>bV@ZA!ZpA;2)`L*&P zqzC8x>_mG}T)Ev)G1KccH}Nw;nL>}5rRgHYPb*FE*K_;imF(JH1bUkh$HkYx4aN5} zkvbbsHs?-YInXKj=FC))?Ri?s;KAYrt<4dGGMrnG3I0jwPOY=4&IC8bRYW}(Yk@Sk zKQB%49?K$W>wqEeZ&>Rgd4>IhG=-1-JNk>D&g++F%CTt}Mc60_{*(YA9AUt?Uu^xZ z9A155I)E=+8PMC-5^&LO`C)4A+eMoSfn}Zs29^o&dcPAvYaRm&JXkuTYrj1Tc9h|Y ze%Uv8{I-AmDB1u_Ex>p70ecW+UjO8uIQ;TMj}75@3!c zx$1j2)D?X{m`laGd6xX+o^>vS0aIQZBSlVIZ=kT3Gh*49Y|P6w@ZsDybt7%jhKyi! z^1=2%bN<;8YJ`n``rdC0#FS`Ws`PUbcRramdu>UQc#n_f5w_{wCXeoOvmo-qkg|;% zvk3ZT+mY$<6RE=(rWV!{dcd3!Cn)c#tLm%I1zK{StDf<-37X+Jb=_;LEV z-Ezo!=GN#t4i{BR8*cTR@!$$I~0xNgt-X67OVbLWNSwjDkwx71l|C zLb^3IbCpKK;jWYrvauW81SNhnPhbC@QG#G_5dvFOI{%7IlhtQ(i7IGdsii%#{s+s{Z733k?U{JuoMi5xR=J9uw)D` z@gnOx=4QpL(Av>vu@{Z3x82PGtywUus^pSZrSnfxa6 zqR&NU4?vGxTZc1d5tW@5RDNu&&jmpMaWjpn1?_nVsY(6nU{O=eUQ`N&h>8?{--o1q`H#nPUj+*x21^IM7#J0p|-yc`$ zKg<^s=d`kL z?kP?eL+hMCelbc1u@OFmjh?9DaUqJov{=nKtj_%l%Q~}mLe+(?SvCtT(qtP^QKgL0 zPW=o~-o8@O5)>Z1@x>r~B~N$5DK|BQ-uwvFL~%{0oV(WsaQ3|IHheLB>dYBeu8+i{ zRc|rPtCPXZE&o~SO|u&@n8Cz}Un;I@ua+NtnNgbC00J_-l6WQWS>$Z%;FJxr&phlJ0Z(QKFc;Rd|= zbO>Vojban4o@3iUHO~jFou#Ty=8UjR@LCxS&k16gnxH{~q>a6}91MYxctnvq7B2iv zcLA}0a{9Zyu6Cv$XeCGx;h`0<(Ta4r@}Q$jVCO4n;pH> zl6F_oFyb;K6V(6-6T?uC6hn{_QS95o4nxhU)SDMsLfOO!|L&I8bkt-zF2a&?QcdA1 z2s0Mz;;6@@n|lQ}{O=K#`}aD*QAm2||vmk89rbY*J35 zHVN_js94U>4KEsBcCL+N>a+OhgdRi)&!*ml=68tQ*^_dsak$&0wl(tNY5qPXRyZ82 zP9jh8nX`n|`7m=-usq+2`?p_)G|>c0FaQUAd7!V8R;aeyVqjdT{+c(Y5^CtzFibvC zg!x%15o=vEZ&_MYQQ|q_Hfsi7m~zsU+a~^DI=z_+*s3{uVLqerah}&bwqG8z$Q!#; z@Po^Z52G_*y_rF3r zP$w>Mt|xPg*U1$it4!^BkPX4eFC4>Jgi2>2y;xO|U~Zxtv;Xs?tOcGUSFSrwKJ=w|sT z;8I7wt9n!Ogk62X*S`uj(1zmaTc_->s=F ztHH*fVuYJ>8MAX~@QT3^9V~Z4jjo$IkPB#bLW@B0!LR9@ONCUv9Z}AjxX$- zoQxEL?WfIwMfxs>@rue_zE>Uc#>3^~?u&FWBCJX;T2jWx#H#d!1%%c(K5kap_=IM6 z@Sw^*0I7_4YY-YhRE}&O3PedTzc;e*8}F-@GC9BF2km=X=yzuXN}2?%9Q^QfNN8{d zzVJ>pJl^bQCHsBenQYgeqtC4}Ca4s0%=F20xW1IOt!{*F`$SXIx@)*#3#dI$k(m7k6_M-SnH|MwpC)02DYF7lA-9*abNGFd#$`R<5qRoVW-ETQ?6o zFE4K=hx@qqaiIVLXv0duR<8<6%t4|sVqMrlf8Y22c=~@<0{ zpTNJ({~=MR>yn^9@c)kx{$F{=uZ6ojfQbd@B(naNWC8-Z;J4?Dp7t$Zf5ilHaa1Hb za^#|Ivp8f(ido44ZL-1BMlEYeu2JtCDyrsQ^p=?^#x_mDqt|}-FKt{balq{IcR_rQ z6zDW*+l%nSALH?2)J?+M7?auTilpR?pc+h?#u+vUU9@YbQ!MTGw-ya_30V{OtUrx6 z=MZ42k3Cj(e{N1KDNHze_6g=i(aa}j_(}2m`Dn%0y4c%b9DwlYstY!Bn6M((fNDsf zf2&0>e?GTmk=^>&Oaw5Jh=Cys^FQyjk&&K>L$f_bn$%b$RO(J|Vx_Q>>jC=L?R)yZ z)u!htn{I(SiJdEsz8k*Zje7klX_rmB@S^ev55vlsttetyJ?H)!(*lvB%Mv&&Zv zHILni-f|M3KF>808WPZAJQn`KiM360O4YHp{s6Lk-Pv;Hus8diaA)?;)${6%bkQdd zH6CL~o*%WmuxKM%jHBA_VWk*Lb4(j-Lco-DFWC)DrKr`6to<;Ctrp z0#mf{f9oj93zn4WZpiz+v8HmNlJnKO@tezUlDt%Z==CgTi(d6u%<16MfBKmDRsZ0# z;ytskiq4-R{S7A5mNSho#IN(9=xi}D$q3lSb59=u3SAUCw&Fl>r5OTg*)UG~){?zg zDnlDeBKhK0k3FwYcux^=B&cT{Kv0N4N(t=Lp?XD368p0iy_SinU5!L6qfl_xn>fo> zQau{7+K7OY@>=>`54qJUia9ac?m`Y4L1NswN%#kuOszC5C_R1&$+5Xi#zGt(6JkA- zb=unTMbQDs9K`y2bO;7)LV!MH1g$0Z=ghl_lZ{p6fgRFs>xY$ik({(s;`~rF^#kmP zS5#ppCKH{UkL^lo9x&-cF3c=6IUjyVO_BZ_R#fsnV&z8$dbNMp2*24zDJt~#Ne#X3 zifpmLw{O_D>HRn#4on&IerbwzQvZp}#*p+&l0sWCXGt+A$@MhedDJ-!V@!PuTMV>Sw)bKh@Qza|CN=_-X z{N7Q`+e0!>UX8?;7ge8^oVh|?()7JBEY_tMmX}L?e%#_|MR7&+3g@Th=i{F%nUv_a z^DIz64_aP7|BRP_2QQn|o(1A~BZAu{^Vc8|^Gw&}g2OblmPm@HZ5t<{aIb(&???Cw z(`o8ikp$jqZE339a$&6Tbios7l`Q*>b(EWJ_>?AEV{x4E3%heiXxAe z2$yiP+sPAhzT5}*s65heRI{>&yRbc-LzZM(TSlRV$XK}9+PHquZR+HOTxvl8F}$s4 zc|>H?tTghMUJ*6-ApmTIj#jG**G8sZOg&{z&xTr_%xSZz|HBUU8VjiEZ}AonnNhsxg58pKp|T{ z|F3ZF|E9}#?l`&I+6COX^XEl-|G+{175~qR68y9JUnHO4AN7C#Kn47TSN-yugb;Nc zKt`R7*3#j$&fKQp+c4b9Mk=M)#>*@|H*KSnkcbxw?r45y+vcp%c~9MZDc1MoZ6&=3 zs}J*_$&*jcE2EaN>TXKN>4fRf41OF|Nve!+%20LrQK=EGq)=f_mnHB(`{bSe>_s;@ z)^7V!vyJBk+A4OW?z^|JFuVf8K(5gba{C=Fq%B*$i3u-LDGrv{>7ybEB{5^6+Y*tq zTTh6Be-LX{1}O6iksuL>zSy@^q=J*6LPWkzUyQw+6fIo(o4OP;8uYSvaq`d-UFb}J zkxwu@69)+?4w6EtN!_GZWX!sZ&*_r)FX)dy Date: Sat, 25 Apr 2026 09:20:45 +0200 Subject: [PATCH 13/13] Implement preloads In this case it should look a lot like preloads "used to" look like on the old yath (still using goto::file, etc.) but it at least now accounts for the new multi-collector model. This one was mostly done via LLM, not just tests, though it at least looked right to me after reviewing the change. Interestingly we avoid the issue of MSWIN_32 here for obvious reasons. Possibly a lot of the issues here could have been solved by using by using MCE as our concurrency model, but that would be a major architectural change and I'm not even sure we need to reach for something that powerful for what we're doing here. Co-Authored-By: Claude Sonnet 4.6 --- lib/App/Yath2/Command/test.pm | 13 +- lib/Test2/Harness2.pm | 54 +++- lib/Test2/Harness2/Collector/Preloaded.pm | 155 +++++++++ lib/Test2/Harness2/Preload.pm | 276 ++++++++++++++++ lib/Test2/Harness2/Preload/Stage.pm | 136 ++++++++ lib/Test2/Harness2/Resource/Preload.pm | 302 ++++++++++++++++++ .../Harness2/ResourceService/PreloadRoot.pm | 228 +++++++++++++ lib/Test2/Harness2/Role/Resource.pm | 4 + t/AI/integration/preload_basic.t | 95 ++++++ t/AI/unit/Harness2/Collector/Preloaded.t | 22 ++ t/AI/unit/Harness2/Preload.t | 134 ++++++++ t/AI/unit/Harness2/Preload/Stage.t | 118 +++++++ t/AI/unit/Harness2/Resource/Preload.t | 208 ++++++++++++ 13 files changed, 1738 insertions(+), 7 deletions(-) create mode 100644 lib/Test2/Harness2/Collector/Preloaded.pm create mode 100644 lib/Test2/Harness2/Preload.pm create mode 100644 lib/Test2/Harness2/Preload/Stage.pm create mode 100644 lib/Test2/Harness2/Resource/Preload.pm create mode 100644 lib/Test2/Harness2/ResourceService/PreloadRoot.pm create mode 100644 t/AI/integration/preload_basic.t create mode 100644 t/AI/unit/Harness2/Collector/Preloaded.t create mode 100644 t/AI/unit/Harness2/Preload.t create mode 100644 t/AI/unit/Harness2/Preload/Stage.t create mode 100644 t/AI/unit/Harness2/Resource/Preload.t diff --git a/lib/App/Yath2/Command/test.pm b/lib/App/Yath2/Command/test.pm index b464ade0b..20f9d65ea 100644 --- a/lib/App/Yath2/Command/test.pm +++ b/lib/App/Yath2/Command/test.pm @@ -27,6 +27,7 @@ use App::Yath2::OutputManager(); use App::Yath2::Options::Renderer(); use App::Yath2::Util::IPC qw/publish_ipc_file unlink_ipc_file/; use Scope::Guard (); +use Test2::Util qw/IS_WIN32/; use Getopt::Yath; include_options( @@ -113,10 +114,20 @@ sub run { my $workdir = $settings->workspace->workdir; + my @resources = (Test2::Harness2::Resource::JobCount->new(slots => 16)); + + if (!IS_WIN32 && $settings->can('runner') && @{$settings->runner->preloads // []}) { + require Test2::Harness2::Resource::Preload; + push @resources => Test2::Harness2::Resource::Preload->new( + preloads => $settings->runner->preloads, + preload_early => $settings->runner->preload_early // {}, + ); + } + my $spawn = Test2::Harness2->spawn( workdir => $workdir, protocol => $settings->ipc->protocol, - resources => [Test2::Harness2::Resource::JobCount->new(slots => 16)], + resources => \@resources, loggers => [ 'Test2::Harness2::Collector::Logger::JSONL', 'Test2::Harness2::Collector::Logger::JSON', diff --git a/lib/Test2/Harness2.pm b/lib/Test2/Harness2.pm index 2412837ee..2551b32d4 100644 --- a/lib/Test2/Harness2.pm +++ b/lib/Test2/Harness2.pm @@ -224,6 +224,15 @@ sub _init_resources { my $has_limiter = grep { $_->is_job_limiter } @{$self->{+RESOURCES}}; push @{$self->{+RESOURCES}} => Test2::Harness2::Resource::JobCount->new(slots => 1) unless $has_limiter; + + for my $res (@{$self->{+RESOURCES}}) { + $res->set_ipcm_info($self->ipcm_info) + if $res->can('set_ipcm_info') && defined $self->ipcm_info; + $res->set_harness_name($self->{+NAME}) + if $res->can('set_harness_name') && defined $self->{+NAME}; + $res->set_logdir($self->{+LOGDIR}) + if $res->can('set_logdir') && defined $self->{+LOGDIR}; + } } sub start { @@ -556,6 +565,9 @@ sub run_on_general_message { return $self->_handle_resource_state_message($kind, $content) if defined $kind && $kind =~ m/^resource_(?:paused|resumed|ready|broken|permanent_broken)$/; + return $self->_handle_stage_message($kind, $content) + if defined $kind && $kind =~ m/^stage_(?:up|down)$/; + # Run-scoped collector_artifacts (run_id defined) flow to the run # service, which logs them as job_loggers on the run's own emitter. # Global collector_artifacts (no run_id -- e.g. from a resource- @@ -623,6 +635,21 @@ sub _handle_resource_state_message { return; } +sub _handle_stage_message { + my ($self, $kind, $content) = @_; + + my $stage = ref($content) eq 'HASH' ? $content->{stage} : undef; + return unless defined $stage; + + my ($res) = grep { $_->can('set_stage_up') } @{$self->{+RESOURCES} // []}; + return unless $res; + + $res->set_stage_up($stage) if $kind eq 'stage_up'; + $res->set_stage_down($stage) if $kind eq 'stage_down'; + + return; +} + sub _seed_artifacts_from_loggers { my $self = shift; @@ -1858,15 +1885,30 @@ sub _launch_job { $res->assign(id => $assign_id, job => $job, env => \%env, %assign_args); } - # Delegate the actual Collector fork to the per-run supervisor so - # the test process runs under the run's subtree. The harness owns - # scheduling (resources assigned above) and the run service owns - # launch + reap + stdio logging. + # Check whether any resource wants to route this job to a preload + # stage rather than the run service. + my $stage_handle; + for my $res (@$resources) { + $stage_handle = $res->stage_handle_for_job($job) and last; + } + + # Delegate the actual Collector fork to either the preload stage + # service (when a stage handle is available) or the per-run + # supervisor. The harness owns scheduling (resources assigned + # above); the run service or stage owns launch + reap. my $launch_ok = eval { - my $handle = $self->_wait_for_run_service_ready($run_id); + my ($handle, $peer); + if ($stage_handle) { + $handle = $stage_handle; + $peer = $stage_handle->service_name; + } + else { + $handle = $self->_wait_for_run_service_ready($run_id); + $peer = "run-$run_id"; + } my $envelope = $handle->sync_request( - "run-$run_id", + $peer, { request => 'launch_job', run_id => $run_id, diff --git a/lib/Test2/Harness2/Collector/Preloaded.pm b/lib/Test2/Harness2/Collector/Preloaded.pm new file mode 100644 index 000000000..90c292f28 --- /dev/null +++ b/lib/Test2/Harness2/Collector/Preloaded.pm @@ -0,0 +1,155 @@ +package Test2::Harness2::Collector::Preloaded; +use strict; +use warnings; + +our $VERSION = '2.000011'; + +use Carp qw/croak/; +use POSIX (); + +use Test2::Harness2::Util::IPC qw/swap_io/; + +use parent 'Test2::Harness2::Collector::Test'; + +use Object::HashBase qw{ + {+TEST_FILE}; + + # Trigger the collector's launch path; _launch_child_unix replaces + # exec with goto::file so the forked child runs the test inline. + $self->{+LAUNCH} //= $self->{+TEST_FILE}; + + $self->SUPER::init(); +} + +sub _launch_child_unix { + my $self = shift; + my ($out_r, $out_w, $err_r, $err_w, $orig_stdout, $orig_stderr) = @_; + + my $test_file = $self->{+TEST_FILE}; + my $stage = $self->{+STAGE}; + + my $pid = fork() // die "Failed to fork preloaded test child: $!"; + + if (!$pid) { + # Child process: set up I/O, then run the test via goto::file + $out_r->close(); + $err_r->close(); + + swap_io(\*STDOUT, $out_w->wh); + swap_io(\*STDERR, $err_w->wh); + STDOUT->autoflush(1); + STDERR->autoflush(1); + + close($orig_stdout); + close($orig_stderr); + + POSIX::setpgid(0, 0) or warn "setpgid(0,0) failed: $!" + if $self->{+NEW_PGROUP}; + + my %env = $self->_child_env_overrides; + $ENV{$_} = $env{$_} for keys %env; + $ENV{T2_HARNESS_FORKED} = 1; + $ENV{T2_HARNESS_PRELOAD} = 1; + + $stage->do_post_fork() if $stage; + + if ($INC{'Test2/API.pm'}) { + Test2::API::test2_stop_preload(); + Test2::API::test2_post_preload_reset(); + Test2::API::test2_enable_trace_stamps(); + } + + $0 = $test_file; + + $stage->do_pre_launch() if $stage; + + require goto::file; + goto::file->import($test_file); + + # Execution of the test begins here (goto::file transfers control). + # When the test exits, the process exits. Any code below is unreachable. + POSIX::_exit(255); + } + + # Parent (collector): restore STDOUT/STDERR + open(STDOUT, '>&', $orig_stdout) or croak "Could not restore STDOUT: $!"; + open(STDERR, '>&', $orig_stderr) or croak "Could not restore STDERR: $!"; + + return $pid; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Harness2::Collector::Preloaded - Collector that runs tests from a +preloaded fork using C. + +=head1 DESCRIPTION + +Extends L for the preload execution path. +Instead of C-ing the test script (which would discard the preloaded +C<%INC> state), this collector forks a child that uses L to swap +in the test script inline. The forked child inherits all preloaded modules +without needing a fresh C. + +=head1 ATTRIBUTES + +=over 4 + +=item test_file (required) + +Absolute path to the test script to execute. + +=item stage (optional) + +A L instance. When set, its +C and C callbacks fire at the appropriate +points in the child process. + +=back + +=head1 SOURCE + +The source code repository for Test2-Harness can be found at +L. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 COPYRIGHT + +Copyright Chad Granum Eexodist7@gmail.comE. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +See L + +=cut diff --git a/lib/Test2/Harness2/Preload.pm b/lib/Test2/Harness2/Preload.pm new file mode 100644 index 000000000..161d0fe74 --- /dev/null +++ b/lib/Test2/Harness2/Preload.pm @@ -0,0 +1,276 @@ +package Test2::Harness2::Preload; +use strict; +use warnings; + +our $VERSION = '2.000011'; + +use Carp qw/croak/; + +use Test2::Harness2::Preload::Stage(); + +sub import { + my $class = shift; + my $caller = caller; + + my $instance = $class->new; + + my %exports; + + $exports{TEST2_HARNESS_PRELOAD} = sub { $instance }; + + $exports{stage} = sub { + my ($name, $code) = @_; + my @caller = caller(); + $instance->build_stage( + name => $name, + code => $code, + caller => \@caller, + ); + }; + + $exports{eager} = sub { + croak "No current stage" unless @{$instance->stack}; + $instance->stack->[-1]->set_eager(1); + }; + + $exports{default} = sub { + croak "No current stage" unless @{$instance->stack}; + $instance->set_default_stage($instance->stack->[-1]->name); + }; + + for my $hook (qw/pre_fork post_fork pre_launch/) { + my $meth = "add_${hook}_callback"; + $exports{$hook} = sub { + croak "No current stage" unless @{$instance->stack}; + $instance->stack->[-1]->$meth(@_); + }; + } + + $exports{watch} = sub { + croak "No current stage" unless @{$instance->stack}; + $instance->stack->[-1]->watch(@_); + }; + + $exports{preload} = sub { + croak "No current stage" unless @{$instance->stack}; + $instance->stack->[-1]->add_to_load_sequence(@_); + }; + + $exports{reload_inplace_check} = sub { + croak "No current stage" unless @{$instance->stack}; + $instance->stack->[-1]->set_reload_inplace_check(@_); + }; + + for my $name (keys %exports) { + no strict 'refs'; + *{"${caller}::${name}"} = $exports{$name}; + } +} + +use Object::HashBase qw{ + {+STAGE_LIST} //= []; + $self->{+STAGE_LOOKUP} //= {}; + $self->{+STACK} //= []; +} + +sub build_stage { + my $self = shift; + my %params = @_; + + my $caller = $params{caller} //= [caller()]; + + die "A coderef is required at $caller->[1] line $caller->[2].\n" + unless $params{code}; + + my $stage = Test2::Harness2::Preload::Stage->new( + stage_lookup => $self->{+STAGE_LOOKUP}, + %params, + ); + + my $stack = $self->{+STACK}; + push @$stack => $stage; + + my $ok = eval { $params{code}->($stage); 1 }; + my $err = $@; + + die "Mangled stack" unless @$stack && $stack->[-1] eq $stage; + pop @$stack; + + die $err unless $ok; + + if (@$stack) { + $stack->[-1]->add_child($stage); + } + else { + $self->add_stage($stage, $caller); + } + + return $stage; +} + +sub add_stage { + my $self = shift; + my ($stage, $caller) = @_; + + $caller //= [caller()]; + + my @all = ($stage, @{$stage->all_children}); + + for my $item (@all) { + my $name = $item->name; + + if (my $existing = $self->{+STAGE_LOOKUP}->{$name}) { + my $ncaller = $item->frame; + my $ecaller = $existing->frame; + die <<" EOT" +A stage named '$name' was already defined. + First at $ecaller->[1] line $ecaller->[2]. + Second at $ncaller->[1] line $ncaller->[2]. + Mixed at $caller->[1] line $caller->[2]. + EOT + } + + $self->{+STAGE_LOOKUP}->{$name} = $item; + } + + push @{$self->{+STAGE_LIST}} => $stage; +} + +sub merge { + my $self = shift; + my ($merge) = @_; + + my $caller = [caller()]; + + $self->add_stage($_, $caller) for @{$merge->{+STAGE_LIST}}; + + $self->{+DEFAULT_STAGE} //= $merge->default_stage; +} + +sub default_stage { + my $self = shift; + return $self->{+DEFAULT_STAGE} if $self->{+DEFAULT_STAGE}; + return $self->{+STAGE_LIST}[0]; +} + +sub set_default_stage { + my $self = shift; + my ($name) = @_; + + croak "Default stage already set to '$self->{+DEFAULT_STAGE}'" + if $self->{+DEFAULT_STAGE}; + + $self->{+DEFAULT_STAGE} = $name; +} + +sub eager_stages { + my $self = shift; + + my %eager; + + for my $root (@{$self->{+STAGE_LIST}}) { + for my $stage ($root, @{$root->all_children}) { + next unless $stage->eager; + $eager{$stage->name} = [map { $_->name } @{$stage->all_children}]; + } + } + + return \%eager; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Harness2::Preload - DSL for building complex stage-based preload tools. + +=head1 DESCRIPTION + +L allows you to preload libraries for a performance boost. +This module provides tools to go further and build a more complex preload with +multiple I: each stage is its own process, and tests can be routed to a +specific stage. This allows for multiple preload states from which to run tests. + +=head1 SYNOPSIS + + package My::Preload; + use strict; + use warnings; + + use Test2::Harness2::Preload; + + stage Moose => sub { + preload 'Moose', 'Moose::Role'; + + eager(); # run child-stage tests here while child loads + default(); # use this stage when none is specified + + pre_fork sub { ... }; + post_fork sub { ... }; + pre_launch sub { ... }; + + stage Types => sub { + preload 'MooseX::Types'; + }; + }; + +=head1 EXPORTS + +=over 4 + +=item TEST2_HARNESS_PRELOAD() + +Returns the meta-object (instance of this class). Its presence is how +Test2::Harness2 distinguishes a preload library from a plain module. + +=item stage NAME => sub { ... } + +Creates a stage. Stages can be nested. + +=item preload @modules_or_coderefs + +Adds to the stage's load sequence. + +=item eager() + +Marks the active stage as eager. + +=item default() + +Designates the active stage as the default. + +=item pre_fork sub { ... } + +=item post_fork sub { ... } + +=item pre_launch sub { ... } + +Lifecycle callbacks around the test-process fork. + +=item watch $file => sub { ... } + +Register a file to watch for changes (requires a reload handler). + +=back + +=head1 SOURCE + +The source code repository for Test2-Harness can be found at +L. + +=cut diff --git a/lib/Test2/Harness2/Preload/Stage.pm b/lib/Test2/Harness2/Preload/Stage.pm new file mode 100644 index 000000000..6784063d4 --- /dev/null +++ b/lib/Test2/Harness2/Preload/Stage.pm @@ -0,0 +1,136 @@ +package Test2::Harness2::Preload::Stage; +use strict; +use warnings; + +our $VERSION = '2.000011'; + +use Carp qw/croak/; +use Test2::Harness2::Util qw/clean_path/; + +use Object::HashBase qw{ + {+FRAME} //= [caller(1)]; + + croak "'name' is a required attribute" unless $self->{+NAME}; + + croak "Stage name 'base' is reserved, pick another name" + if $self->{+NAME} eq 'base'; + croak "Stage name 'NOPRELOAD' is reserved, pick another name" + if $self->{+NAME} eq 'NOPRELOAD'; + + $self->{+CHILDREN} //= []; + + $self->{+PRE_FORK_CALLBACKS} //= []; + $self->{+POST_FORK_CALLBACKS} //= []; + $self->{+PRE_LAUNCH_CALLBACKS} //= []; + + $self->{+LOAD_SEQUENCE} //= []; + $self->{+WATCHES} //= {}; +} + +sub watch { + my $self = shift; + my ($file, $callback) = @_; + croak "The first argument must be a file" unless $file && -f $file; + croak "The callback argument is required" + unless $callback && ref($callback) eq 'CODE'; + + $file = clean_path($file); + + croak "There is already a watch on file '$file'" + if $self->{+WATCHES}->{$file}; + + $self->{+WATCHES}->{$file} = $callback; +} + +sub all_children { + my $self = shift; + + my @out = @{$self->{+CHILDREN}}; + + for (my $i = 0; $i < @out; $i++) { + push @out => @{$out[$i]->children}; + } + + return \@out; +} + +sub add_child { + my $self = shift; + my ($stage) = @_; + push @{$self->{+CHILDREN}} => $stage; +} + +sub add_pre_fork_callback { + my $self = shift; + my ($cb) = @_; + croak "Callback must be a coderef" unless ref($cb) eq 'CODE'; + push @{$self->{+PRE_FORK_CALLBACKS}} => $cb; +} + +sub add_post_fork_callback { + my $self = shift; + my ($cb) = @_; + croak "Callback must be a coderef" unless ref($cb) eq 'CODE'; + push @{$self->{+POST_FORK_CALLBACKS}} => $cb; +} + +sub add_pre_launch_callback { + my $self = shift; + my ($cb) = @_; + croak "Callback must be a coderef" unless ref($cb) eq 'CODE'; + push @{$self->{+PRE_LAUNCH_CALLBACKS}} => $cb; +} + +sub add_to_load_sequence { + my $self = shift; + + for my $item (@_) { + croak "Item '$item' is not a valid preload, must be a module name (scalar) or a coderef" + unless ref($item) eq 'CODE' || !ref($item); + push @{$self->{+LOAD_SEQUENCE}} => $item; + } +} + +sub do_pre_fork { my $self = shift; $_->(@_) for @{$self->{+PRE_FORK_CALLBACKS}} } +sub do_post_fork { my $self = shift; $_->(@_) for @{$self->{+POST_FORK_CALLBACKS}} } +sub do_pre_launch { my $self = shift; $_->(@_) for @{$self->{+PRE_LAUNCH_CALLBACKS}} } + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Harness2::Preload::Stage - Abstraction of a preload stage. + +=head1 DESCRIPTION + +Implementation detail of L. You are not intended to +directly use or modify instances of this class. See L +for documentation on writing a custom preload library. + +=head1 SOURCE + +The source code repository for Test2-Harness can be found at +L. + +=cut diff --git a/lib/Test2/Harness2/Resource/Preload.pm b/lib/Test2/Harness2/Resource/Preload.pm new file mode 100644 index 000000000..e624a45f0 --- /dev/null +++ b/lib/Test2/Harness2/Resource/Preload.pm @@ -0,0 +1,302 @@ +package Test2::Harness2::Resource::Preload; +use strict; +use warnings; + +our $VERSION = '2.000011'; + +use Carp qw/croak/; + +use Test2::Harness2::Util qw/mod2file load_module/; + +use Test2::Harness2::Preload(); +use Test2::Harness2::Preload::Stage(); + +use Object::HashBase qw{ + {+PRELOADS} //= []; + $self->{+PRELOAD_EARLY} //= {}; + $self->{+HARNESS_NAME} //= 'harness'; + $self->{+STAGE_STATES} //= {}; + $self->{+JOB_STAGES} //= {}; + $self->{+STAGE_HANDLES} //= {}; + + my $tree = Test2::Harness2::Preload->new; + + for my $mod (@{$self->{+PRELOADS}}) { + my $ok = eval { require(mod2file($mod)); 1 }; + my $err = $@; + unless ($ok) { + warn "Failed to load preload module '$mod': $err"; + next; + } + $tree->merge($mod->TEST2_HARNESS_PRELOAD()) if $mod->can('TEST2_HARNESS_PRELOAD'); + } + + $self->{+STAGE_TREE} = $tree; + + $self->{+STAGE_STATES}{'preload-root'} = 'pending'; + $self->{+STAGE_STATES}{$_} = 'pending' for keys %{$tree->stage_lookup}; +} + +sub is_broken { $_[0]->{+BROKEN} ? 1 : 0 } +sub is_permanent_broken { $_[0]->{+PERMANENT_BROKEN} ? 1 : 0 } +sub is_paused { $_[0]->{+PAUSED} ? 1 : 0 } + +sub mark_broken { $_[0]->{+BROKEN} = 1 } + +sub mark_permanent_broken { + my $self = shift; + $self->{+BROKEN} = 1; + $self->{+PERMANENT_BROKEN} = 1; +} + +sub mark_paused { $_[0]->{+PAUSED} = 1 } + +sub mark_resumed { + my $self = shift; + $self->{+PAUSED} = 0; + $self->{+BROKEN} = 0 unless $self->{+PERMANENT_BROKEN}; +} + +sub set_ipcm_info { + my ($self, $info) = @_; + $self->{+IPCM_INFO} = $info; + $self->{+STAGE_HANDLES} = {}; +} + +sub needed { + my ($self, %p) = @_; + my $job = $p{job} or croak "'job' is required"; + return $job->test_file->check_feature('preload') ? 1 : 0; +} + +sub available { + my ($self, %p) = @_; + my $job = $p{job} or croak "'job' is required"; + + my $stage_name = $self->_stage_for_job($job); + my $state = $self->{+STAGE_STATES}{$stage_name} // 'pending'; + + return 0 unless $state eq 'up'; + return 1; +} + +sub assign { + my ($self, %p) = @_; + + my $id = $p{id} or croak "'id' is required"; + my $job = $p{job} or croak "'job' is required"; + + croak "duplicate assign for id '$id'" if exists $self->{+JOB_STAGES}{$id}; + + $self->{+JOB_STAGES}{$id} = $self->_stage_for_job($job); + return 1; +} + +sub release { + my ($self, %p) = @_; + my $id = $p{id} or croak "'id' is required"; + delete $self->{+JOB_STAGES}{$id}; + return 1; +} + +sub services { + my $self = shift; + + return ( + [ + 'Test2::Harness2::ResourceService::PreloadRoot', + name => 'preload-root', + preloads => $self->{+PRELOADS}, + preload_early => $self->{+PRELOAD_EARLY}, + harness_name => $self->{+HARNESS_NAME}, + (defined $self->{+LOGDIR} ? (logdir => $self->{+LOGDIR}) : ()), + ], + ); +} + +sub set_stage_up { + my ($self, $name) = @_; + $self->{+STAGE_STATES}{$name} = 'up'; + $self->{+BROKEN} = 0 unless $self->{+PERMANENT_BROKEN}; +} + +sub set_stage_down { + my ($self, $name) = @_; + $self->{+STAGE_STATES}{$name} = 'down'; +} + +sub stage_handle_for_job { + my ($self, $job) = @_; + + return undef unless $self->{+IPCM_INFO}; + + my $stage_name = $self->_stage_for_job($job); + return undef unless ($self->{+STAGE_STATES}{$stage_name} // '') eq 'up'; + + return $self->{+STAGE_HANDLES}{$stage_name} //= do { + require IPC::Manager::Service::Handle; + IPC::Manager::Service::Handle->new( + service_name => $stage_name, + ipcm_info => $self->{+IPCM_INFO}, + ); + }; +} + +sub status { + my $self = shift; + + return { + resource => $self->resource_name, + broken => $self->is_broken, + paused => $self->is_paused, + permanent => $self->is_permanent_broken, + stages => {%{$self->{+STAGE_STATES}}}, + }; +} + +sub _stage_for_job { + my ($self, $job) = @_; + + my $tf = $job->test_file; + my $requested = $tf->check_stage if $tf->can('check_stage'); + + if ($requested && exists $self->{+STAGE_STATES}{$requested}) { + return $requested; + } + + my $default = $self->{+STAGE_TREE}->default_stage; + if ($default) { + my $name = ref($default) ? $default->name : $default; + return $name if exists $self->{+STAGE_STATES}{$name}; + } + + return 'preload-root'; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Harness2::Resource::Preload - Resource that routes tests through +preload stage services. + +=head1 DESCRIPTION + +Implements L for preload support. +Reads the preload DSL from the modules listed in C, builds +an internal stage tree, and declares a +L service. The harness +injects C after construction so the resource can build +L objects for routing C +requests to the appropriate stage service. + +Stage state (C / C / C) is updated by the harness +when it receives C / C service events from the +PreloadRoot service. + +=head1 ATTRIBUTES + +=over 4 + +=item preloads + +Arrayref of module names. Plain modules are loaded by the stage service; +modules that export C contribute stage-tree +definitions that drive per-test routing. + +=item preload_early + +Optional hashref of early-load modules passed through to the root +service (loaded before the preload recipe). + +=back + +=head1 METHODS + +Implements the L interface. See that +role for the contract on C, C, C, C, +and C. + +=over 4 + +=item $resource->set_ipcm_info($info) + +Inject the harness's C so the resource can create service +handles. Invalidates any cached stage handles. + +=item $resource->set_stage_up($name) + +Mark stage C<$name> as ready. Clears transient brokenness on the +resource (but not permanent brokenness). + +=item $resource->set_stage_down($name) + +Mark stage C<$name> as down. + +=item $handle_or_undef = $resource->stage_handle_for_job($job) + +Return an L for the stage that should +run C<$job>, or C if C has not been injected yet or +the target stage is not up. + +=back + +=head1 SOURCE + +The source code repository for Test2-Harness can be found at +L. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 COPYRIGHT + +Copyright Chad Granum Eexodist7@gmail.comE. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +See L + +=cut diff --git a/lib/Test2/Harness2/ResourceService/PreloadRoot.pm b/lib/Test2/Harness2/ResourceService/PreloadRoot.pm new file mode 100644 index 000000000..44674ed82 --- /dev/null +++ b/lib/Test2/Harness2/ResourceService/PreloadRoot.pm @@ -0,0 +1,228 @@ +package Test2::Harness2::ResourceService::PreloadRoot; +use strict; +use warnings; + +our $VERSION = '2.000011'; + +use Carp qw/croak/; +use POSIX (); + +use Test2::Harness2::Util qw/mod2file/; + +use Object::HashBase qw{ + {request}; + $inner = {request => $inner} unless ref($inner) eq 'HASH'; + + my $type = $inner->{request}; + my $handler = "request_handler_$type"; + + return {ok => 0, error => "missing request type"} unless defined $type; + return $self->$handler($inner) if $self->can($handler); + return {ok => 0, error => "unknown request '$type'"}; +} + +sub run_on_start { + my $self = shift; + + $ENV{T2_TRACE_STAMPS} = 1; + + if (eval { require Test2::API; 1 }) { + Test2::API::test2_start_preload(); + Test2::API::test2_enable_trace_stamps(); + } + + for my $mod (@{$self->{+PRELOADS}}) { + my $ok = eval { require(mod2file($mod)); 1 }; + my $err = $@; + warn "PreloadRoot: failed to load '$mod': $err" unless $ok; + } + + $self->_send_to_harness({kind => 'stage_up', stage => $self->{+NAME}, pid => $$}); +} + +sub run_on_cleanup { + my $self = shift; + $self->_send_to_harness({kind => 'stage_down', stage => $self->{+NAME}}); +} + +sub request_handler_launch_job { + my ($self, $payload) = @_; + + for my $req (qw/job_id run_id test_file/) { + return {ok => 0, error => "'$req' is required"} unless defined $payload->{$req}; + } + + my $job_id = $payload->{job_id}; + my $job_try = $payload->{job_try} // 0; + my $run_id = $payload->{run_id}; + my $env = $payload->{env} // {}; + my $auditor = $payload->{auditor}; + my $test_abs = $payload->{test_file}; + + return {ok => 0, error => "'test_file' must be absolute"} + unless $test_abs =~ m{^/}; + + pipe(my $r, my $w) // die "pipe: $!"; + + my $ipid = fork // die "Failed to fork intermediary: $!"; + + if ($ipid) { + close $w; + my $cpid_str = do { local $/; <$r> }; + close $r; + waitpid($ipid, 0); + + return {ok => 0, error => "failed to obtain collector pid from intermediary"} + unless defined $cpid_str && $cpid_str =~ m/^\d+$/; + + return {ok => 1, pid => 0 + $cpid_str}; + } + + # Intermediary child + close $r; + + my $handle; + my $spawn_ok = eval { + require Test2::Harness2::Collector::Preloaded; + $handle = Test2::Harness2::Collector::Preloaded->spawn( + new_pgroup => 1, + parent_pids => [$$], + env_vars => {T2_FORMATTER => 'Stream2', %$env}, + logdir => $self->{+LOGDIR}, + run_id => $run_id, + job_id => $job_id, + job_try => $job_try, + ipcm_info => $self->ipcm_info, + ipc_parent => "run-$run_id", + ipc_run => "run-$run_id", + ipc_harness => $self->{+HARNESS_NAME} // 'harness', + test_file => $test_abs, + (defined $auditor ? (auditor => $auditor) : ()), + ); + 1; + }; + my $spawn_err = $@; + + if ($spawn_ok && $handle) { + print $w $handle->pid; + } + else { + warn "PreloadRoot: collector spawn failed: $spawn_err"; + } + + close $w; + POSIX::_exit($spawn_ok ? 0 : 1); +} + +sub _send_to_harness { + my ($self, $msg) = @_; + + my $ok = eval { + require IPC::Manager::Service::Handle; + my $hname = $self->{+HARNESS_NAME} // 'harness'; + my $handle = IPC::Manager::Service::Handle->new( + service_name => $hname, + ipcm_info => $self->ipcm_info, + ); + $handle->client->send_message($hname, $msg); + 1; + }; + warn "PreloadRoot: could not notify harness: $@" unless $ok; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Harness2::ResourceService::PreloadRoot - IPC::Manager service that +loads preload modules and launches tests from a forked state. + +=head1 DESCRIPTION + +This is the resource service that backs L. +It runs as a long-lived supervised subprocess managed by the harness. + +On startup (C) it enables the C preload mode, +loads every module listed in C, and sends a C message +to the harness so the preload resource can begin routing jobs here. + +When the harness sends a C request, C +performs the double-fork detachment pattern: + +=over 4 + +=item 1. + +Fork a short-lived B child. + +=item 2. + +The intermediary forks the B (a +L) and exits immediately, detaching +the collector from this service's process tree. + +=item 3. + +The stage reads the collector pid from a pipe and returns it as the +C response. + +=back + +On shutdown (C) it sends a C message to the +harness. + +=head1 SOURCE + +The source code repository for Test2-Harness can be found at +L. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 COPYRIGHT + +Copyright Chad Granum Eexodist7@gmail.comE. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +See L + +=cut diff --git a/lib/Test2/Harness2/Role/Resource.pm b/lib/Test2/Harness2/Role/Resource.pm index 804a84392..b88f72bf6 100644 --- a/lib/Test2/Harness2/Role/Resource.pm +++ b/lib/Test2/Harness2/Role/Resource.pm @@ -74,6 +74,10 @@ sub services { () } # (harness shutdown) or per-run (run completes). Default: no-op. sub teardown { } +# Resources that route test launches to a stage service override this. +# Returns undef (use the run service) or an IPC::Manager::Service::Handle. +sub stage_handle_for_job { undef } + 1; __END__ diff --git a/t/AI/integration/preload_basic.t b/t/AI/integration/preload_basic.t new file mode 100644 index 000000000..820340f3f --- /dev/null +++ b/t/AI/integration/preload_basic.t @@ -0,0 +1,95 @@ +use Test2::V0; +use File::Temp qw/tempdir/; +use Time::HiRes qw/time sleep/; + +use Test2::Util qw/IS_WIN32/; +plan skip_all => 'preload requires Unix (fork + goto::file)' if IS_WIN32; + +use lib 't/lib'; +use Test2::Harness2::TestFile; +use Test2::Harness2::Test::Loggers qw/classic_harness_loggers classic_test_loggers/; +use Test2::Harness2::Test::SpawnRace qw/finish_and_wait/; + +use Test2::Harness2; +use Test2::Harness2::Resource::JobCount; +use Test2::Harness2::Resource::Preload; + +sub wait_until { + my ($check, $timeout_sec) = @_; + my $deadline = time + $timeout_sec; + while (time < $deadline) { + return 1 if $check->(); + sleep(0.05); + } + return 0; +} + +subtest 'test launched via preload stage sees env var and preloaded module' => sub { + my $dir = tempdir(CLEANUP => 1); + + # The test script verifies it is running in preload mode and that the + # preloaded module is visible in %INC (inherited from the stage fork). + my $tf_path = "$dir/preloaded_test.t"; + open my $fh, '>', $tf_path or die "Cannot write test file: $!"; + print $fh "use Test2::V0;\n"; + print $fh "ok(\$ENV{T2_HARNESS_PRELOAD}, 'T2_HARNESS_PRELOAD env set by Collector::Preloaded');\n"; + print $fh "ok(\$INC{'Scalar/Util.pm'}, 'Scalar::Util preloaded into %INC by the stage service');\n"; + print $fh "done_testing;\n"; + close $fh; + + my $preload_res = Test2::Harness2::Resource::Preload->new( + preloads => ['Scalar::Util'], + ); + + my $spawn = Test2::Harness2->spawn( + workdir => $dir, + resources => [ + Test2::Harness2::Resource::JobCount->new(slots => 4), + $preload_res, + ], + loggers => classic_harness_loggers($dir), + test_loggers => classic_test_loggers(), + ); + + my $queued = $spawn->queue_test_run( + files => [Test2::Harness2::TestFile->new(file => $tf_path)], + ); + ok($queued->{ok}, 'run queued') or diag explain $queued; + my $run_id = $queued->{run_id}; + + # Poll until the run reports complete. The preload stage needs to come + # up before the scheduler dispatches the job, which adds a few seconds. + my $service_gone_re = qr/peer .* went away|is not a valid message recipient/; + my $timeout = 60; + my $deadline = time + $timeout; + my $final; + my $service_gone; + while (time < $deadline) { + my $resp = eval { $spawn->run_results(run_id => $run_id) }; + my $err = $@; + if (!defined $resp) { + last unless $err =~ $service_gone_re; + $service_gone = 1; + last; + } + next unless $resp->{ok}; + if (($resp->{state} // '') eq 'complete') { + $final = $resp; + last; + } + sleep(0.1); + } + + ok(defined $final || $service_gone, 'run completed or service exited cleanly'); + ok(!$service_gone, 'service did not disappear unexpectedly') + unless defined $final; + + finish_and_wait($spawn); + + SKIP: { + skip 'no final result (service gone before reporting)', 1 unless $final; + ok($final->{pass}, 'run passed — test assertions verified preload mode'); + } +}; + +done_testing; diff --git a/t/AI/unit/Harness2/Collector/Preloaded.t b/t/AI/unit/Harness2/Collector/Preloaded.t new file mode 100644 index 000000000..70a3eed3e --- /dev/null +++ b/t/AI/unit/Harness2/Collector/Preloaded.t @@ -0,0 +1,22 @@ +use Test2::V0; + +use Test2::Util qw/IS_WIN32/; +plan skip_all => 'Collector::Preloaded requires Unix (fork + goto::file)' if IS_WIN32; + +use Test2::Harness2::Collector::Preloaded; + +subtest 'inherits from Collector::Test' => sub { + ok( + Test2::Harness2::Collector::Preloaded->isa('Test2::Harness2::Collector::Test'), + 'is a Collector::Test', + ); +}; + +subtest 'init croaks without test_file' => sub { + my $ok = eval { Test2::Harness2::Collector::Preloaded->new; 1 }; + my $err = $@; + ok(!$ok, 'dies without test_file'); + like($err, qr/test_file/, 'error mentions test_file'); +}; + +done_testing; diff --git a/t/AI/unit/Harness2/Preload.t b/t/AI/unit/Harness2/Preload.t new file mode 100644 index 000000000..482fee649 --- /dev/null +++ b/t/AI/unit/Harness2/Preload.t @@ -0,0 +1,134 @@ +use Test2::V0; + +use Test2::Harness2::Preload; +use Test2::Harness2::Preload::Stage; + +# Each package installs DSL via 'use' at compile time; the stage() calls +# below run at file-load time (before any subtest). + +{ package My::Preload::One; + use Test2::Harness2::Preload; + stage 'Alpha' => sub { preload 'Scalar::Util'; }; } + +{ package My::Preload::Two; + use Test2::Harness2::Preload; + stage 'Foo' => sub {}; + stage 'Bar' => sub {}; } + +{ package My::Preload::Nested; + use Test2::Harness2::Preload; + stage 'Root' => sub { stage 'Child' => sub {}; }; } + +{ package My::Preload::ExplicitDefault; + use Test2::Harness2::Preload; + stage 'First' => sub {}; + stage 'Second' => sub { default(); }; } + +{ package My::Preload::ImplicitDefault; + use Test2::Harness2::Preload; + stage 'Alpha' => sub {}; + stage 'Beta' => sub {}; } + +{ package My::Preload::Eager; + use Test2::Harness2::Preload; + stage 'EagerStage' => sub { eager(); }; + stage 'QuietStage' => sub {}; } + +{ package My::Preload::DupFirst; + use Test2::Harness2::Preload; + stage 'Dup' => sub {}; } # first registration; second call in subtest should croak + +{ package My::Preload::BadCode; + use Test2::Harness2::Preload; } # no stages yet; used for error-propagation test + +{ package My::Preload::MergeA; + use Test2::Harness2::Preload; + stage 'StageA' => sub {}; } + +{ package My::Preload::MergeB; + use Test2::Harness2::Preload; + stage 'StageB' => sub {}; } + +# --------------------------------------------------------------------------- + +subtest 'TEST2_HARNESS_PRELOAD returns the Preload instance' => sub { + my $p = My::Preload::One::TEST2_HARNESS_PRELOAD(); + isa_ok($p, 'Test2::Harness2::Preload'); +}; + +subtest 'exports land in caller namespace' => sub { + for my $name (qw/ TEST2_HARNESS_PRELOAD stage preload eager default + pre_fork post_fork pre_launch watch reload_inplace_check /) { + ok(My::Preload::One->can($name), "$name exported"); + } +}; + +subtest 'stage_list and stage_lookup reflect top-level stages' => sub { + my $p = My::Preload::Two::TEST2_HARNESS_PRELOAD(); + is(scalar @{$p->stage_list}, 2, 'two top-level stages'); + is($p->stage_list->[0]->name, 'Foo', 'first stage is Foo'); + is($p->stage_list->[1]->name, 'Bar', 'second stage is Bar'); + ok(exists $p->stage_lookup->{Foo}, 'Foo in lookup'); + ok(exists $p->stage_lookup->{Bar}, 'Bar in lookup'); +}; + +subtest 'nested stage goes into lookup but not top-level list' => sub { + my $p = My::Preload::Nested::TEST2_HARNESS_PRELOAD(); + is(scalar @{$p->stage_list}, 1, 'one top-level stage'); + ok(exists $p->stage_lookup->{Root}, 'Root in lookup'); + ok(exists $p->stage_lookup->{Child}, 'Child also in lookup'); +}; + +subtest 'explicit default_stage' => sub { + my $p = My::Preload::ExplicitDefault::TEST2_HARNESS_PRELOAD(); + is($p->default_stage, 'Second', 'explicit default_stage is Second'); +}; + +subtest 'implicit default_stage falls back to first stage' => sub { + my $p = My::Preload::ImplicitDefault::TEST2_HARNESS_PRELOAD(); + my $ds = $p->default_stage; + my $name = ref($ds) ? $ds->name : $ds; + is($name, 'Alpha', 'implicit default is the first stage'); +}; + +subtest 'eager_stages' => sub { + my $p = My::Preload::Eager::TEST2_HARNESS_PRELOAD(); + my $eager = $p->eager_stages; + ok(exists $eager->{EagerStage}, 'eager stage in eager_stages'); + ok(!exists $eager->{QuietStage}, 'non-eager stage absent'); +}; + +subtest 'duplicate stage name croaks' => sub { + my $ok = eval { My::Preload::DupFirst::stage('Dup', sub {}); 1 }; + my $err = $@; + ok(!$ok, 'second registration of Dup dies'); + like($err, qr/already defined/, 'error says "already defined"'); +}; + +subtest 'stage code error propagates' => sub { + my $ok = eval { My::Preload::BadCode::stage('Baddie', sub { die "intentional error\n" }); 1 }; + my $err = $@; + ok(!$ok, 'stage with dying code propagates error'); + like($err, qr/intentional error/, 'correct error text'); +}; + +subtest 'set_default_stage croaks when called a second time' => sub { + my $p = Test2::Harness2::Preload->new; + $p->set_default_stage('First'); + my $ok = eval { $p->set_default_stage('Second'); 1 }; + my $err = $@; + ok(!$ok, 'second call to set_default_stage dies'); + like($err, qr/already set/, 'error says "already set"'); +}; + +subtest 'merge combines two preload trees' => sub { + my $combined = Test2::Harness2::Preload->new; + $combined->merge(My::Preload::MergeA::TEST2_HARNESS_PRELOAD()); + $combined->merge(My::Preload::MergeB::TEST2_HARNESS_PRELOAD()); + + is(scalar @{$combined->stage_list}, 2, 'two stages after merge'); + ok(exists $combined->stage_lookup->{StageA}, 'StageA in merged tree'); + ok(exists $combined->stage_lookup->{StageB}, 'StageB in merged tree'); +}; + +done_testing; diff --git a/t/AI/unit/Harness2/Preload/Stage.t b/t/AI/unit/Harness2/Preload/Stage.t new file mode 100644 index 000000000..b3cdffbf1 --- /dev/null +++ b/t/AI/unit/Harness2/Preload/Stage.t @@ -0,0 +1,118 @@ +use Test2::V0; + +use Test2::Harness2::Preload::Stage; + +subtest 'constructor requires a name' => sub { + my $ok = eval { Test2::Harness2::Preload::Stage->new; 1 }; + my $err = $@; + ok(!$ok, 'dies without name'); + like($err, qr/required/, 'error mentions "required"'); +}; + +subtest 'reserved name "base" is rejected' => sub { + my $ok = eval { Test2::Harness2::Preload::Stage->new(name => 'base'); 1 }; + my $err = $@; + ok(!$ok, 'dies on reserved name "base"'); + like($err, qr/reserved/, 'error mentions "reserved"'); +}; + +subtest 'reserved name "NOPRELOAD" is rejected' => sub { + my $ok = eval { Test2::Harness2::Preload::Stage->new(name => 'NOPRELOAD'); 1 }; + my $err = $@; + ok(!$ok, 'dies on reserved name "NOPRELOAD"'); + like($err, qr/reserved/, 'error mentions "reserved"'); +}; + +subtest 'defaults are sensible' => sub { + my $s = Test2::Harness2::Preload::Stage->new(name => 'Foo'); + is($s->name, 'Foo', 'name set'); + is($s->children, [], 'children empty'); + is($s->load_sequence, [], 'load_sequence empty'); + is($s->pre_fork_callbacks, [], 'pre_fork_callbacks empty'); + is($s->post_fork_callbacks, [], 'post_fork_callbacks empty'); + is($s->pre_launch_callbacks, [], 'pre_launch_callbacks empty'); + is($s->watches, {}, 'watches empty'); + ok(!$s->eager, 'not eager by default'); +}; + +subtest 'add_child and all_children' => sub { + my $root = Test2::Harness2::Preload::Stage->new(name => 'Root'); + my $child = Test2::Harness2::Preload::Stage->new(name => 'Child'); + my $grand = Test2::Harness2::Preload::Stage->new(name => 'Grand'); + + $root->add_child($child); + $child->add_child($grand); + + is(scalar @{$root->children}, 1, 'root has one direct child'); + is($root->children->[0]->name, 'Child', 'direct child is Child'); + + my $all = $root->all_children; + is(scalar @$all, 2, 'all_children returns direct + transitive descendants'); + my %names = map { $_->name => 1 } @$all; + ok($names{Child}, 'Child in all_children'); + ok($names{Grand}, 'Grand in all_children'); +}; + +subtest 'add_to_load_sequence' => sub { + my $s = Test2::Harness2::Preload::Stage->new(name => 'Seq'); + $s->add_to_load_sequence('Scalar::Util', 'List::Util'); + my $cb = sub { 1 }; + $s->add_to_load_sequence($cb); + + is(scalar @{$s->load_sequence}, 3, 'three items in sequence'); + is($s->load_sequence->[0], 'Scalar::Util', 'first item'); + is($s->load_sequence->[1], 'List::Util', 'second item'); + is($s->load_sequence->[2], $cb, 'third is coderef'); +}; + +subtest 'add_to_load_sequence rejects invalid items' => sub { + my $s = Test2::Harness2::Preload::Stage->new(name => 'Bad'); + my $ok = eval { $s->add_to_load_sequence({}); 1 }; + ok(!$ok, 'dies on hashref'); + like($@, qr/not a valid preload/, 'error mentions "not a valid preload"'); +}; + +subtest 'do_pre_fork fires callbacks in order' => sub { + my $s = Test2::Harness2::Preload::Stage->new(name => 'CBOrder'); + my @log; + $s->add_pre_fork_callback(sub { push @log => 'a' }); + $s->add_pre_fork_callback(sub { push @log => 'b' }); + $s->do_pre_fork; + is(\@log, [qw/a b/], 'pre_fork callbacks fired in order'); +}; + +subtest 'do_post_fork fires callbacks in order' => sub { + my $s = Test2::Harness2::Preload::Stage->new(name => 'PostFork'); + my @log; + $s->add_post_fork_callback(sub { push @log => 1 }); + $s->add_post_fork_callback(sub { push @log => 2 }); + $s->do_post_fork; + is(\@log, [1, 2], 'post_fork callbacks fired in order'); +}; + +subtest 'do_pre_launch fires callbacks in order' => sub { + my $s = Test2::Harness2::Preload::Stage->new(name => 'PreLaunch'); + my @log; + $s->add_pre_launch_callback(sub { push @log => 'x' }); + $s->add_pre_launch_callback(sub { push @log => 'y' }); + $s->do_pre_launch; + is(\@log, [qw/x y/], 'pre_launch callbacks fired in order'); +}; + +subtest 'add_*_callback rejects non-coderefs' => sub { + my $s = Test2::Harness2::Preload::Stage->new(name => 'NoRef'); + for my $method (qw/add_pre_fork_callback add_post_fork_callback add_pre_launch_callback/) { + my $ok = eval { $s->$method('not a code'); 1 }; + ok(!$ok, "$method rejects non-coderef"); + like($@, qr/coderef/, 'error mentions "coderef"'); + } +}; + +subtest 'eager flag' => sub { + my $s = Test2::Harness2::Preload::Stage->new(name => 'EagerOne'); + ok(!$s->eager, 'not eager initially'); + $s->set_eager(1); + ok($s->eager, 'eager after set_eager(1)'); +}; + +done_testing; diff --git a/t/AI/unit/Harness2/Resource/Preload.t b/t/AI/unit/Harness2/Resource/Preload.t new file mode 100644 index 000000000..2caecc1ee --- /dev/null +++ b/t/AI/unit/Harness2/Resource/Preload.t @@ -0,0 +1,208 @@ +use Test2::V0; + +# Use the production TestFile from lib/ (not the t/lib stub) so that +# check_feature('preload') returns the %DEFAULTS value of 1 when the +# feature is not explicitly set -- the stub version has no defaults. +use Test2::Harness2::TestFile; +use Test2::Harness2::Run::Job; +use Test2::Harness2::Resource::Preload; + +# Fake preload module with one named stage for routing tests. +{ + package My::Resource::Test::StagePreload; + use Test2::Harness2::Preload; + stage 'Alpha' => sub {}; +} +$INC{'My/Resource/Test/StagePreload.pm'} = 1; + +sub make_job { + my (%tf_attrs) = @_; + my $tf = Test2::Harness2::TestFile->new(file => 't/x.t', %tf_attrs); + return Test2::Harness2::Run::Job->new(test_file => $tf, run_id => 'r'); +} + +subtest 'construction with empty preloads' => sub { + my $r = Test2::Harness2::Resource::Preload->new(preloads => []); + ok($r, 'constructed without error'); + is($r->resource_name, 'preload', 'resource_name is "preload"'); +}; + +subtest 'consumes Role::Resource' => sub { + require Role::Tiny; + my $r = Test2::Harness2::Resource::Preload->new(preloads => []); + ok( + Role::Tiny::does_role($r, 'Test2::Harness2::Role::Resource'), + 'Preload consumes Role::Resource', + ); +}; + +subtest 'is_job_limiter is false' => sub { + my $r = Test2::Harness2::Resource::Preload->new(preloads => []); + ok(!$r->is_job_limiter, 'not a job limiter'); +}; + +subtest 'needed: returns 1 by default, 0 when preload feature disabled' => sub { + my $r = Test2::Harness2::Resource::Preload->new(preloads => []); + + my $j_default = make_job(); + my $j_disabled = make_job(features => {preload => 0}); + + is($r->needed(job => $j_default), 1, 'needed=1 when preload is enabled (default)'); + is($r->needed(job => $j_disabled), 0, 'needed=0 when preload explicitly disabled'); +}; + +subtest 'available: defers while stage is pending, grants when up' => sub { + my $r = Test2::Harness2::Resource::Preload->new(preloads => []); + my $j = make_job(); + + is($r->available(job => $j), 0, 'available=0 while stage is pending'); + + $r->set_stage_up('preload-root'); + is($r->available(job => $j), 1, 'available=1 after stage comes up'); +}; + +subtest 'assign and release bookkeeping' => sub { + my $r = Test2::Harness2::Resource::Preload->new(preloads => []); + $r->set_stage_up('preload-root'); + + my $j = make_job(); + is($r->assign(id => 'x1', job => $j), 1, 'assign returns 1'); + + ok(exists $r->{'job_stages'}{'x1'}, 'job_stages entry created'); + is($r->{'job_stages'}{'x1'}, 'preload-root', 'job mapped to preload-root stage'); + + $r->release(id => 'x1'); + ok(!exists $r->{'job_stages'}{'x1'}, 'job_stages entry removed after release'); +}; + +subtest 'duplicate assign id is rejected' => sub { + my $r = Test2::Harness2::Resource::Preload->new(preloads => []); + $r->set_stage_up('preload-root'); + my $j = make_job(); + $r->assign(id => 'dup', job => $j); + my $ok = eval { $r->assign(id => 'dup', job => $j); 1 }; + ok(!$ok, 'second assign with same id dies'); + like($@, qr/duplicate assign/, 'error mentions "duplicate assign"'); +}; + +subtest 'services() returns single PreloadRoot entry with correct keys' => sub { + my $r = Test2::Harness2::Resource::Preload->new( + preloads => ['Scalar::Util'], + preload_early => {SomeModule => [1]}, + harness_name => 'test-harness', + ); + + my @svc = $r->services; + is(scalar @svc, 1, 'one service entry'); + + my ($class, %args) = @{$svc[0]}; + is($class, 'Test2::Harness2::ResourceService::PreloadRoot', 'correct service class'); + is($args{name}, 'preload-root', 'name is preload-root'); + is($args{harness_name}, 'test-harness', 'harness_name forwarded'); + is($args{preloads}, ['Scalar::Util'], 'preloads forwarded'); + ok(exists $args{preload_early}, 'preload_early forwarded'); +}; + +subtest 'status reports stage states and health flags' => sub { + my $r = Test2::Harness2::Resource::Preload->new(preloads => []); + my $s = $r->status; + is($s->{resource}, 'preload', 'resource key present'); + is($s->{broken}, 0, 'not broken initially'); + is($s->{paused}, 0, 'not paused initially'); + is($s->{permanent}, 0, 'not permanently broken initially'); + ok(exists $s->{stages}{'preload-root'}, 'preload-root in stages'); + is($s->{stages}{'preload-root'}, 'pending', 'initial state is pending'); +}; + +subtest 'set_stage_up / set_stage_down transitions' => sub { + my $r = Test2::Harness2::Resource::Preload->new(preloads => []); + is($r->status->{stages}{'preload-root'}, 'pending', 'starts pending'); + + $r->set_stage_up('preload-root'); + is($r->status->{stages}{'preload-root'}, 'up', 'up after set_stage_up'); + + $r->set_stage_down('preload-root'); + is($r->status->{stages}{'preload-root'}, 'down', 'down after set_stage_down'); +}; + +subtest 'brokenness / paused states' => sub { + my $r = Test2::Harness2::Resource::Preload->new(preloads => []); + ok($r->is_usable, 'usable when healthy'); + + $r->mark_broken; + ok($r->is_broken, 'broken after mark_broken'); + ok(!$r->is_usable, 'not usable when broken'); + + $r->mark_resumed; + ok(!$r->is_broken, 'no longer broken after mark_resumed'); + ok($r->is_usable, 'usable after mark_resumed'); + + $r->mark_paused; + ok($r->is_paused, 'paused after mark_paused'); + ok(!$r->is_usable, 'not usable when paused'); + + $r->mark_resumed; + ok(!$r->is_paused, 'not paused after mark_resumed'); +}; + +subtest 'mark_permanent_broken survives mark_resumed' => sub { + my $r = Test2::Harness2::Resource::Preload->new(preloads => []); + $r->mark_permanent_broken; + ok($r->is_broken, 'broken after mark_permanent_broken'); + ok($r->is_permanent_broken, 'permanent_broken set'); + + $r->mark_resumed; + ok($r->is_permanent_broken, 'permanent_broken survives resume'); + ok($r->is_broken, 'is_broken persists too (set by permanent_broken)'); +}; + +subtest 'stage_handle_for_job returns undef without ipcm_info' => sub { + my $r = Test2::Harness2::Resource::Preload->new(preloads => []); + $r->set_stage_up('preload-root'); + my $j = make_job(); + is($r->stage_handle_for_job($j), undef, 'undef when ipcm_info not set'); +}; + +subtest '_stage_for_job routes to named stage when job check_stage matches' => sub { + my $r = Test2::Harness2::Resource::Preload->new( + preloads => ['My::Resource::Test::StagePreload'], + ); + + # Stage 'Alpha' is in the stage tree; bring it up so available() returns 1. + $r->set_stage_up('Alpha'); + + my $j_alpha = make_job(stage => 'Alpha'); + is($r->available(job => $j_alpha), 1, 'available=1 for job routed to named stage Alpha'); + + $r->assign(id => 's1', job => $j_alpha); + is($r->{'job_stages'}{'s1'}, 'Alpha', 'job assigned to Alpha stage'); +}; + +subtest '_stage_for_job falls back to preload-root when requested stage is unknown' => sub { + my $r = Test2::Harness2::Resource::Preload->new(preloads => []); + $r->set_stage_up('preload-root'); + + # 'Nonexistent' is not in the stage_states; should fall back to preload-root. + my $j = make_job(stage => 'Nonexistent'); + is($r->available(job => $j), 1, 'available=1 after falling back to preload-root'); + + $r->assign(id => 'fb1', job => $j); + is($r->{'job_stages'}{'fb1'}, 'preload-root', 'fallback job assigned to preload-root'); +}; + +subtest '_stage_for_job uses default stage from tree when no stage requested' => sub { + my $r = Test2::Harness2::Resource::Preload->new( + preloads => ['My::Resource::Test::StagePreload'], + ); + + # Alpha is the first (and only) stage, so it becomes the implicit default. + $r->set_stage_up('Alpha'); + + my $j = make_job(); # no stage preference + is($r->available(job => $j), 1, 'available=1 routed to tree default stage Alpha'); + + $r->assign(id => 'def1', job => $j); + is($r->{'job_stages'}{'def1'}, 'Alpha', 'default-routed job assigned to Alpha'); +}; + +done_testing;