Test2-Harness-1.000158/0000755000175000017500000000000015012417054014271 5ustar exodistexodistTest2-Harness-1.000158/xt/0000755000175000017500000000000015012417054014724 5ustar exodistexodistTest2-Harness-1.000158/xt/author/0000755000175000017500000000000015012417054016226 5ustar exodistexodistTest2-Harness-1.000158/xt/author/pod-syntax.t0000644000175000017500000000025215012417054020520 0ustar exodistexodist#!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); Test2-Harness-1.000158/xt/author/pod-spell.t0000644000175000017500000000273215012417054020316 0ustar exodistexodistuse strict; use warnings; use Test2::Require::AuthorTesting; use Test2::Require::Module 'Test::Spelling'; use Test::Spelling; my @stopwords; for () { chomp; push @stopwords, $_ unless /\A (?: \# | \s* \z)/msx; # skip comments, whitespace } print "### adding stopwords @stopwords\n"; add_stopwords(@stopwords); local $ENV{LC_ALL} = 'C'; set_spell_cmd('aspell list -l en'); all_pod_files_spelling_ok; __DATA__ ## personal names binkley Bowden Daly dfs Eryq EXODIST Fergal Glew Granum Oxley Pritikin Schwern Skoll Slaymaker ZeeGee ## proper names Fennec ICal xUnit ## test jargon Diag diag isnt subtest subtests testsuite testsuites TODO todo todos untestable EventFacet EventFacets renderers xt ## computerese blackbox BUF codeblock combinatorics dir getline getlines getpos Getter getters HashBase heisenbug IPC NBYTES param perlish perl-qa POS predeclaring rebless refactoring refcount Reinitializes SCALARREF setpos Setter SHM sref subevent subevents testability TIEHANDLE tie-ing unoverload VMS vmsperl YESNO ansi html HASHBASE renderer SHBANG JSONL YATH jsonl rc tmpdir utils workdir Postfix env bz bzip preloaded Yath vv PRELOAD yath preloads Preload pPlugin tlib preload loadim preloading shm qvf mem ## other jargon, slang 17th AHHHHHHH Dummy globalest Hmmm cid tid pid SIGINT SIGALRM SIGHUP SIGTERM SIGUSR1 SIGUSR2 webhook integrations IMMISCIBLE POSTEXIT lff backfill ESYNC muxed ## Spelled correctly according to google: recognise recognises judgement Test2-Harness-1.000158/lib/0000755000175000017500000000000015012417054015037 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/0000755000175000017500000000000015012417054016040 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Tools/0000755000175000017500000000000015012417054017140 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Tools/HarnessTester.pm0000644000175000017500000000760715012417054022302 0ustar exodistexodistpackage Test2::Tools::HarnessTester; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Harness::Util::UUID qw/gen_uuid/; use App::Yath::Tester qw/make_example_dir/; use Importer Importer => qw/import/; our @EXPORT_OK = qw/make_example_dir summarize_events/; my $HARNESS_ID = 1; sub summarize_events { my ($events) = @_; my @caller = caller(0); my $id = $HARNESS_ID++; my $run_id = "run-$id"; my $job_id = "job-$id"; require Test2::Harness::Auditor::Watcher; my $watcher = Test2::Harness::Auditor::Watcher->new(job => 1, try => 0); require Test2::Harness::Event; for my $e (@$events) { my $fd = $e->facet_data; my $he = Test2::Harness::Event->new( facet_data => $fd, event_id => gen_uuid(), run_id => $run_id, job_id => $job_id, stamp => time, job_try => 0, ); $watcher->process($he); } return { plan => $watcher->plan, pass => $watcher->pass ? 1 : 0, fail => $watcher->fail ? 1 : 0, errors => $watcher->_errors, failures => $watcher->_failures, assertions => $watcher->assertion_count, }; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Tools::HarnessTester - Run events through a harness for a summary =head1 DESCRIPTION This tool allows you to process events through the L auditor. The main benefit here is to get a pass/fail result, as well as counts for assertions, failures, and errors. =head1 SYNOPSIS use Test2::V0; use Test2::API qw/intercept/; use Test2::Tools::HarnessTester qw/summarize_events/; my $events = intercept { ok(1, "pass"); ok(2, "pass gain"); done_testing; }; is( summarize_events($events), { # Each of these is the negation of the other, no need to check both pass => 1, fail => 0, # The plan facet, see Test2::EventFacet::Plan plan => {count => 2}, # Statistics assertions => 2, errors => 0, failures => 0, } ); =head1 EXPORTS =head2 $summary = summarize_events($events) This takes an arrayref of events, such as that produced by C from L. The result is a hashref that summarizes the results of the events as processed by L, specifically the L module. Fields in the summary hash: =over 4 =item pass => $BOOL =item fail => $BOOL These are negatives of eachother. These represent the pass/fail state after processing the events. When one is true the other should be false. These are normalized to C<1> and C<0>. =item plan => $HASHREF If a plan was provided this will have the L facet, but as a hashref, not a blessed instance. B This is reference to the original data, not a copy, if you modify it you will modify the event as well. =item assertions => $INT Count of assertions made. =item errors => $INT Count of errors seen. =item failures => $INT Count of failures seen. =back =head2 $path = make_example_dir() This will create a temporary directory with 't', 't2', and 'xt' subdirectories each of which will contain a single passing test. This is re-exported from L. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Formatter/0000755000175000017500000000000015012417054020003 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Formatter/Test2/0000755000175000017500000000000015012417054021004 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Formatter/Test2/Composer.pm0000644000175000017500000002777715012417054023155 0ustar exodistexodistpackage Test2::Formatter::Test2::Composer; use strict; use warnings; our $VERSION = '1.000158'; use Scalar::Util qw/blessed/; use List::Util qw/first/; sub new { my $class = shift; return bless({}, $class); } sub render_one_line { my $class = shift; my $in = shift; my $f = blessed($in) ? $in->facet_data : $in; return [$f->{render}->[0]->{facet}, uc($f->{render}->[0]->{tag}), $f->{render}->[0]->{details}] if $f->{render} && @{$f->{render}}; return (($class->halt($f))[0]) if $class->{control} && defined $class->{control}->{halt}; for my $type (qw/assert errors plan info times about/) { next unless $f->{$type}; my $m = "render_$type"; my ($out) = $class->$m($f); return $out if defined $out; } return; } sub render_verbose { my $class = shift; my ($in, %params) = @_; my $f = blessed($in) ? $in->facet_data : $in; return [map {[$_->{facet}, uc($_->{tag}), $_->{details}]} @{$f->{render}}] if $f->{render} && @{$f->{render}}; my @out; push @out => $class->render_control($f, %params) if $f->{control}; push @out => $class->render_plan($f) if $f->{plan}; if ($f->{assert}) { push @out => $class->render_assert($f); push @out => $class->render_debug($f) unless $f->{assert}->{pass} || $f->{assert}->{no_debug}; push @out => $class->render_amnesty($f) if $f->{amnesty} && @{$f->{amnesty}}; } push @out => $class->render_info($f) if $f->{info}; push @out => $class->render_errors($f) if $f->{errors}; push @out => $class->render_about($f) if $f->{about} && !(@out || first { $f->{$_} } qw/stop plan info nest assert/); return \@out; } sub render_super_verbose { my $class = shift; my ($in) = @_; my $out = $class->render_verbose($in, super_verbose => 1); my $f = blessed($in) ? $in->facet_data : $in; push @$out => $class->render_launch($f) if $f->{harness_job_launch}; push @$out => $class->render_start($f) if $f->{harness_job_start}; push @$out => $class->render_exit($f) if $f->{harness_job_exit}; push @$out => $class->render_end($f) if $f->{harness_job_end}; unless (@$out) { my ($name, $fallback); for my $k (sort keys %$f) { my $v = $f->{$k}; # Fallback should be longest harness* facet name $fallback = $k if $k =~ m/harness/ && (!$fallback || length($fallback) < length($k)); my $list = ref($v) eq 'ARRAY' ? $v : [$v]; for my $i (@$list) { next unless ref($i); last if $name = $i->{details}; } } $name //= $fallback // join ', ' => sort keys %$f; push @$out => ['harness', 'HARNESS', $name]; } return $out; } sub render_launch { my $class = shift; my ($f) = @_; return ['harness', 'HARNESS', 'Job Launched at ' . $f->{harness_job_launch}->{stamp}]; } sub render_start { my $class = shift; my ($f) = @_; return ['harness', 'HARNESS', $f->{harness_job_start}->{details}]; } sub render_exit { my $class = shift; my ($f) = @_; return ['harness', 'HARNESS', $f->{harness_job_exit}->{details}]; } sub render_end { my $class = shift; my ($f) = @_; return ['harness', 'HARNESS', "Job completed at " . $f->{harness_job_end}->{stamp}]; } sub render_control { my $class = shift; my ($f, %params) = @_; my @out; push @out => ['control', 'HALT', $f->{control}->{details}] if defined $f->{control}->{halt}; return @out unless $params{super_verbose}; push @out => ['control', 'ENCODING', $f->{control}->{encoding}] if $f->{control}->{encoding}; return @out if @out; return ['control', 'CONTROL', $f->{control}->{details}] if defined $f->{control}->{details}; return; } my %SHOW_BRIEF_TAGS = ( 'CRITICAL' => 1, 'DEBUG' => 1, 'DIAG' => 1, 'ERROR' => 1, 'FAIL' => 1, 'FAILED' => 1, 'FATAL' => 1, 'HALT' => 1, 'PASSED' => 1, 'REASON' => 1, 'STDERR' => 1, 'TIMEOUT' => 1, 'WARN' => 1, 'WARNING' => 1, 'KILL' => 1, 'SKIPPED' => 1, ); my %SHOW_BRIEF_FACETS = ( control => 1, error => 1, trace => 1, ); sub render_brief { my $class = shift; my $in = shift; my $f = blessed($in) ? $in->facet_data : $in; if ($f->{render} && @{$f->{render}}) { my @show = grep { $SHOW_BRIEF_TAGS{uc($_->{tag})} || $SHOW_BRIEF_FACETS{lc($_->{facet})} } @{$f->{render}}; return [map { [$_->{facet}, uc($_->{tag}), $_->{details}] } @show]; } my @out; push @out => $class->render_control($f) if $f->{control}; if ($f->{assert} && !$f->{assert}->{pass} && !$f->{amnesty}) { push @out => $class->render_assert($f); push @out => $class->render_debug($f) unless $f->{assert}->{no_debug}; } if ($f->{info}) { my $if = {%$f, info => [grep { $_->{debug} || $_->{important} } @{$f->{info}}]}; push @out => $class->render_info($if) if @{$if->{info}}; } push @out => $class->render_errors($f) if $f->{errors}; return \@out; } sub render_plan { my $class = shift; my ($f) = @_; my $plan = $f->{plan}; return ['plan', 'NO PLAN', $f->{plan}->{details}] if $plan->{none}; if ($plan->{skip}) { return ['plan', 'SKIP ALL', $f->{plan}->{details}] if $f->{plan}->{details}; return ['plan', 'SKIP ALL', "No reason given"]; } return ['plan', 'PLAN', "Expected assertions: $f->{plan}->{count}"]; } sub render_assert { my $class = shift; my ($f) = @_; my $name = $f->{assert}->{details} || ''; return ['assert', '! PASS !', $name] if $f->{amnesty} && @{$f->{amnesty}}; return ['assert', 'PASS', $name] if $f->{assert}->{pass}; return ['assert', 'FAIL', $name] } sub render_amnesty { my $class = shift; my ($f) = @_; my %seen; return map { $seen{join '' => @{$_}{qw/tag details/}}++ ? () : ['amnesty', $_->{tag}, $_->{details}] } @{$f->{amnesty}}; } sub render_debug { my $class = shift; my ($f) = @_; my $name = $f->{assert}->{details}; my $trace = $f->{trace}; my $debug; if ($trace) { $debug = $trace->{details}; if(!$debug && $trace->{frame}) { my $frame = $trace->{frame}; $debug = "$frame->[1] line $frame->[2]"; } } $debug ||= "[No trace info available]"; chomp($debug); return ['trace', 'DEBUG', $debug]; } sub render_info { my $class = shift; my ($f) = @_; return map { my $details = $_->{details} // ''; my $msg; if (ref($details)) { require Data::Dumper; my $dumper = Data::Dumper->new([$details])->Indent(2)->Terse(1)->Useqq(1)->Sortkeys(1); chomp($msg = $dumper->Dump); } else { chomp($msg = $details); } ['info', $_->{tag}, $details, $_->{table} || ()] } @{$f->{info}}; } sub render_about { my $class = shift; my ($f) = @_; return if $f->{about}->{no_display}; return unless $f->{about} && $f->{about}->{details}; my $type; if ($f->{about}->{package}) { my $type = $f->{about}->{package}; $type =~ s/^.*:://; } $type //= 'ABOUT'; return ['about', $type, $f->{about}->{details}]; } sub render_errors { my $class = shift; my ($f) = @_; return map { my $details = $_->{details}; my $msg; if (ref($details)) { require Data::Dumper; my $dumper = Data::Dumper->new([$details])->Indent(2)->Terse(1)->Useqq(1)->Sortkeys(1); chomp($msg = $dumper->Dump); } else { chomp($msg = $details); } my $tag = $_->{tag} || ($_->{fail} ? 'FATAL' : 'ERROR'); ['error', $tag, $details] } @{$f->{errors}}; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Formatter::Test2::Composer - Compose output components from event facets =head1 DESCRIPTION This is used by L to turn events into output components. This logic lives here instead of in the formatter because it is also used by L. Other tools may also find this conversion useful. =head1 SYNOPSIS use Test2::Formatter::Test2::Composer; # Note, all methods are class methods, this is just here for convenience. my $comp = Test2::Formatter::Test2::Composer->new(); my $out = $comp->render_one_line($event); my ($facet_name, $tag_string, $text_for_humans) = @$out; ... for my $line ($comp->render_verbose($event)) { my ($facet_name, $tag_string, $text_for_humans) = @$line; ..., } =head1 METHODS All methods are class methods, but they also work just fine on a blessed instance. There is no benefit to a blessed instance, but you can create one for convenience if it makes you more comfortable. =over 4 =item $inst = $class->new() Create a blessed instance. This is here for convenience only. All methods are class methods. =item $arrayref = $class->render_one_line($event) =item $arrayref = $class->render_one_line(\%facet_data) my $out = $comp->render_one_line($event); my ($facet_name, $tag_string, $text_for_humans) = @$out; This will return a single line of output from the event, even if the event would normally return multiple lines. In order of priority: =over 4 =item Custom 'render' facet =item Control 'halt' facet (bail-out) =item Assertion (pass/fail) =item Error message =item Plan =item Info (note/diag) =item Timing data =item About =back =item @lines = $class->render_verbose($event, %control_params) =item @lines = $class->render_verbose(\%facet_data, %control_params) This will verbosely render any event. The C<%control_params> are passed directly to C and are not used for anything else. for my $line ($comp->render_verbose($event)) { my ($facet_name, $tag_string, $text_for_humans) = @$line; ..., } =item @lines = $class->render_super_verbose($event) =item @lines = $class->render_super_verbose(\%facet_data) This is even more verbose than C because it produces output lines even for facets that should normally not be seen, things that would usually be considered noise. This is mainly useful for tools that allow deep inspection of log files. =back =head2 FACET RENDERERS With exception of C these are all the same. These all take C<\%facet_data> as their only argument, and return a list of line-arrayrefs C<[$facet, $tag, $text_for_humans]>. =over 4 =item @lines = $class->render_control(\%facet_data, super_verbose => $bool) This specific one is special in that it can take an extra argument. This argument is used to toggle between super_verbose and regular verbosity. No other facet renderer needs this toggle. If omitted it defaults to not being super verbose. =item @lines = $class->render_launch(\%facet_data) =item @lines = $class->render_start(\%facet_data) =item @lines = $class->render_exit(\%facet_data) =item @lines = $class->render_end(\%facet_data) =item @lines = $class->render_brief(\%facet_data) =item @lines = $class->render_plan(\%facet_data) =item @lines = $class->render_assert(\%facet_data) =item @lines = $class->render_amnesty(\%facet_data) =item @lines = $class->render_debug(\%facet_data) =item @lines = $class->render_info(\%facet_data) =item @lines = $class->render_about(\%facet_data) =item @lines = $class->render_errors(\%facet_data) =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Formatter/Stream.pm0000644000175000017500000002761515012417054021607 0ustar exodistexodistpackage Test2::Formatter::Stream; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak confess/; use Time::HiRes qw/time/; use IO::Handle; use File::Spec(); use List::Util qw/first/; use Test2::Harness::Util::UUID qw/gen_uuid/; use Test2::Harness::Util::JSON qw/JSON JSON_IS_XS/; use Test2::Harness::Util qw/hub_truth apply_encoding/; use Test2::Util qw/get_tid ipc_separator/; use parent qw/Test2::Formatter/; use Test2::Util::HashBase qw/-io _encoding _no_header _no_numbers _no_diag -stream_id -tb -tb_handles -dir -_pid -_tid -_fh new; $J->indent(0); $J->convert_blessed(1); $J->allow_blessed(1); $J->utf8(1); require constant; constant->import(ENCODER => $J); if (JSON_IS_XS) { require JSON::PP; my $JPP = JSON::PP->new; $JPP->indent(0); $JPP->convert_blessed(1); $JPP->allow_blessed(1); $JPP->utf8(1); constant->import(ENCODER_PP => $JPP); } } my ($ROOT_TID, $ROOT_PID, $ROOT_DIR, $ROOT_JOB_ID, $ROOT_UGIDS); sub import { my $class = shift; my %params = @_; confess "$class no longer accept the 'file' argument, it now takes a 'dir' argument" if exists $params{file}; $class->SUPER::import(); $ROOT_PID = $$; $ROOT_TID = get_tid(); $ROOT_DIR = $params{dir} if $params{dir}; $ROOT_JOB_ID = $params{job_id} if $params{job_id}; $ROOT_UGIDS = [$<, $>, $(, $)]; if ($ROOT_DIR && ! -d $ROOT_DIR) { mkdir($ROOT_DIR) or die "Could not make root dir: $!"; } } sub hide_buffered { 0 } sub fh { my $self = shift; my $dir = $self->{+DIR} or return undef; my $pid = $self->{+_PID}; my $tid = $self->{+_TID}; if ($pid && $pid != $$) { delete $self->{+_PID}; delete $self->{+_FH}; } if ($tid && $tid != get_tid()) { delete $self->{+_TID}; delete $self->{+_FH}; } return $self->{+_FH} if $self->{+_FH}; $self->{+STREAM_ID} = 1; $pid = $self->{+_PID} = $$; $tid = $self->{+_TID} = get_tid(); my $file = File::Spec->catfile($dir, join(ipc_separator() => 'events', $pid, $tid) . ".jsonl"); my @now = ($<, $>, $(, $)); local ($<, $>, $(, $)) = @{$self->{+UGIDS}} if $self->{+UGIDS} && first { $self->{+UGIDS}->[$_] ne $now[$_] } 0 .. $#now; mkdir($dir) or die "Could not make dir '$dir': $!" unless -d $dir; confess "File '$file' already exists!" if -f $file; open(my $fh, '>', $file) or die "Could not open file: $file"; $fh->autoflush(1); # Do not apply encoding to the UTF8 output, we let the utf8 formatter # handle that. This means do not apply encoding to $self->{+_FH}. return $self->{+_FH} = $fh; } sub init { my $self = shift; $self->{+STREAM_ID} = 1; $self->{+UGIDS} //= [$<, $>, $(, $)]; # To create necessary directories as soon as possible $self->fh(); for (@{$self->{+IO}}) { $_->autoflush(1); } STDOUT->autoflush(1); STDERR->autoflush(1); if ($INC{'Test2/API.pm'}) { Test2::API::test2_stdout()->autoflush(1); Test2::API::test2_stderr()->autoflush(1); } if ($self->{check_tb}) { require Test::Builder::Formatter; $self->{+TB} = Test::Builder::Formatter->new(); $self->{+TB_HANDLES} = [@{$self->{+TB}->handles}]; } } sub new_root { my $class = shift; my %params = @_; $ROOT_PID = $$ unless defined $ROOT_PID; $ROOT_TID = get_tid() unless defined $ROOT_TID; confess "new_root called from child process!" if $ROOT_PID != $$; confess "new_root called from child thread!" if $ROOT_TID != get_tid(); require Test2::API; my $io = $params{+IO} = [Test2::API::test2_stdout(), Test2::API::test2_stderr()]; $_->autoflush(1) for @$io; confess "T2_STREAM_FILE is no longer used, see T2_STREAM_DIR" if exists $ENV{T2_STREAM_FILE}; $params{+DIR} ||= $ENV{T2_STREAM_DIR} || $ROOT_DIR; $params{+JOB_ID} ||= $ENV{T2_STREAM_JOB_ID} || $ROOT_JOB_ID || 1; # DO NOT REOPEN THEM! delete $ENV{T2_FORMATTER} if $ENV{T2_FORMATTER} && $ENV{T2_FORMATTER} eq 'Stream'; delete $ENV{T2_STREAM_DIR}; delete $ENV{T2_STREAM_JOB_ID}; $ROOT_DIR = undef; $params{check_tb} = 1 if $INC{'Test/Builder.pm'}; $params{+UGIDS} = $ROOT_UGIDS if $ROOT_UGIDS; return $class->new(%params); } sub record { my $self = shift; my ($facets, $num) = @_; my $stamp = time; my $times = [times]; my @sync = @{$self->{+IO}}; my $leader = 0; my $fh = $self->fh; unless($fh) { $leader = 1; $fh = shift @sync; } if ($facets->{control}->{halt}) { my $reason = $facets->{control}->{details} || ""; if ($leader) { print $fh "\nBail out! $reason\n"; } else { open(my $bh, '>', File::Spec->catfile($self->{+DIR}, 'bail')) or die "Could not create bail file: $!"; print $bh $reason; close($bh); } } my $tid = get_tid(); my $id = $self->{+STREAM_ID}++; my $json; { no warnings 'once'; local *UNIVERSAL::TO_JSON = sub { "$_[0]" }; my $event_id = $facets->{about}->{uuid} ||= gen_uuid(); if (JSON_IS_XS) { for my $encoder (ENCODER, ENCODER_PP) { local $@; my $ok = eval { $json = $encoder->encode( { stamp => $stamp, times => $times, stream_id => $id, tid => $tid, pid => $$, event_id => $event_id, facet_data => $facets, assert_count => $self->{+_NO_NUMBERS} ? undef : $num, } ); 1; }; my $err = $@; last if $ok; # Intercept bug in JSON::XS so we can fall back to JSON::PP next if $encoder eq ENCODER && $err =~ m/Modification of a read-only value attempted/; # Different error, time to die. die $err; } } else { $json = ENCODER->encode( { stamp => $stamp, times => $times, stream_id => $id, tid => $tid, pid => $$, event_id => $event_id, facet_data => $facets, assert_count => $self->{+_NO_NUMBERS} ? undef : $num, } ); } } # Local is expensive! Only do it if we really need to. local($\, $,) = (undef, '') if $\ || $,; my $job_id = $self->{+JOB_ID}; print $fh $leader ? ("T2-HARNESS-$job_id-EVENT: ", $json, "\n") : ($json, "\n"); print $_ "T2-HARNESS-$job_id-ESYNC: ", join(ipc_separator() => $$, $tid, $id) . "\n" for @sync; } sub encoding { my $self = shift; if (@_) { my ($enc) = @_; $self->record({control => {encoding => $enc}}); $self->_set_encoding($enc); $self->{+TB}->encoding($enc) if $self->{+TB}; } return $self->{+_ENCODING}; } sub _set_encoding { my $self = shift; if (@_) { my ($enc) = @_; # Do not apply encoding to the UTF8 output, we let the utf8 formatter # handle that. This means do not apply encoding to $self->{+_FH}. apply_encoding(\*STDOUT, $enc); apply_encoding(\*STDERR, $enc); my $job_id = $self->{+JOB_ID}; for my $fh (@{$self->{+IO}}) { print $fh "T2-HARNESS-$job_id-ENCODING: $enc\n"; apply_encoding($fh, $enc); } } return $self->{+_ENCODING}; } if ($^C) { no warnings 'redefine'; *write = sub { }; } sub write { my ($self, $e, $num, $f) = @_; $f ||= $e->facet_data; $self->_set_encoding($f->{control}->{encoding}) if $f->{control}->{encoding}; # Hide these if we must, but do not remove them for good. local $f->{info} if $self->{+_NO_DIAG}; local $f->{plan} if $self->{+_NO_HEADER}; my $tb_only = 0; if ($self->{+TB}) { $tb_only ||= $self->{+TB_HANDLES}->[0] != $self->{+TB}->{handles}->[0]; $tb_only ||= $self->{+TB_HANDLES}->[1] != $self->{+TB}->{handles}->[1]; my $todo_match = $self->{+TB_HANDLES}->[0] == $self->{+TB}->{handles}->[2] || $self->{+TB_HANDLES}->[1] == $self->{+TB}->{handles}->[2]; $tb_only ||= !$todo_match; if ($tb_only) { my $buffered = hub_truth($f)->{buffered}; $self->{+TB}->write($e, $num, $f) if $self->{+TB} && !$buffered; return; } } $self->record($f, $num); } sub no_header { $_[0]->{+_NO_HEADER} } sub no_diag { $_[0]->{+_NO_DIAG} } sub no_numbers { $_[0]->{+_NO_NUMBERS} } sub handles { my $self = shift; return $self->{+TB}->handles if $self->{+TB}; return; } sub set_no_header { my $self = shift; ($self->{+_NO_HEADER}) = @_; $self->{+TB}->set_no_header(@_) if $self->{+TB}; $self->{+_NO_HEADER}; } sub set_no_diag { my $self = shift; ($self->{+_NO_DIAG}) = @_; $self->{+TB}->set_no_diag(@_) if $self->{+TB}; $self->{+_NO_DIAG}; } sub set_no_numbers { my $self = shift; ($self->{+_NO_NUMBERS}) = @_; $self->{+TB}->set_no_numbers(@_) if $self->{+TB}; $self->{+_NO_NUMBERS}; } sub set_handles { my $self = shift; return $self->{+TB}->set_handles(@_) if $self->{+TB}; return; } sub terminate { my $self = shift; return $self->SUPER::terminate(@_) unless $self->{+TB}; return $self->{+TB}->terminate(@_); } sub finalize { my $self = shift; return $self->SUPER::finalize(@_) unless $self->{+TB}; return $self->{+TB}->finalize(@_); } sub DESTROY {} our $AUTOLOAD; sub AUTOLOAD { my $this = shift; my $meth = $AUTOLOAD; $meth =~ s/^.*:://g; my $type = ref($this); return $this->{+TB}->$meth(@_) if $type && $this->{+TB} && $this->{+TB}->can($meth); $type ||= $this; croak qq{Can't locate object method "$meth" via package "$type"}; } sub isa { my $in = shift; return $in->SUPER::isa(@_) unless ref($in) && $in->{+TB}; return $in->SUPER::isa(@_) || $in->{+TB}->isa(@_); } sub can { my $in = shift; return $in->SUPER::can(@_) unless ref($in) && $in->{+TB}; return $in->SUPER::can(@_) || $in->{+TB}->can(@_); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Formatter::Stream - Test2 Formatter that directly writes events. =head1 DESCRIPTION This formatter writes all test2 events to event files (one per process/thread) instead of writing them to STDERR/STDOUT. It will output synchronization messages to STDERR/STDOUT every time an event is written. From this data the test output can be properly reconstructed in order with STDERR/STDOUT and events mostly synced so that they appear in the correct order. This formatter is not usually useful to humans. This formatter is used by L when possible to prevent the loss of data that normally occurs when TAP is used. =head1 SYNOPSIS If you really want your test to output this: use Test2::Formatter::Stream; use Test2::V0; ... Otherwise just use L without the C<--no-stream> argument and this formatter will be used when possible. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Formatter/Test2.pm0000644000175000017500000005213315012417054021346 0ustar exodistexodistpackage Test2::Formatter::Test2; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Util::Term qw/term_size/; use Test2::Harness::Util qw/hub_truth apply_encoding/; use Test2::Harness::Util::Term qw/USE_ANSI_COLOR/; use Test2::Util qw/IS_WIN32 clone_io/; use Time::HiRes qw/time/; use IO::Handle; use File::Spec(); use Test2::Formatter::Test2::Composer; use parent 'Test2::Formatter'; sub import { my $class = shift; return if $ENV{HARNESS_ACTIVE}; $class->SUPER::import; } use Test2::Util::HashBase qw{ -composer -last_depth -_buffered Term::ANSIColor::color('red'), 'DIAG' => Term::ANSIColor::color('yellow'), 'ERROR' => Term::ANSIColor::color('red'), 'FATAL' => Term::ANSIColor::color('bold red'), 'FAIL' => Term::ANSIColor::color('red'), 'HALT' => Term::ANSIColor::color('bold red'), 'PASS' => Term::ANSIColor::color('green'), '! PASS !' => Term::ANSIColor::color('cyan'), 'TODO' => Term::ANSIColor::color('cyan'), 'NO PLAN' => Term::ANSIColor::color('yellow'), 'SKIP' => Term::ANSIColor::color('bold cyan'), 'SKIP ALL' => Term::ANSIColor::color('bold white on_blue'), 'STDERR' => Term::ANSIColor::color('yellow'), 'RUN INFO' => Term::ANSIColor::color('bold bright_blue'), 'JOB INFO' => Term::ANSIColor::color('bold bright_blue'), 'LAUNCH' => Term::ANSIColor::color('bold bright_white'), 'RETRY' => Term::ANSIColor::color('bold bright_white'), 'PASSED' => Term::ANSIColor::color('bold bright_green'), 'TO RETRY' => Term::ANSIColor::color('bold bright_yellow'), 'FAILED' => Term::ANSIColor::color('bold bright_red'), 'REASON' => Term::ANSIColor::color('magenta'), 'TIMEOUT' => Term::ANSIColor::color('magenta'), 'TIME' => Term::ANSIColor::color('blue'), 'MEMORY' => Term::ANSIColor::color('blue'), ); } sub DEFAULT_FACET_COLOR() { return ( time => Term::ANSIColor::color('blue'), memory => Term::ANSIColor::color('blue'), about => Term::ANSIColor::color('magenta'), amnesty => Term::ANSIColor::color('cyan'), assert => Term::ANSIColor::color('bold bright_white'), control => Term::ANSIColor::color('bold red'), error => Term::ANSIColor::color('yellow'), info => Term::ANSIColor::color('yellow'), meta => Term::ANSIColor::color('magenta'), parent => Term::ANSIColor::color('magenta'), trace => Term::ANSIColor::color('bold red'), ); } # These colors all look decent enough to use, ordered to avoid putting similar ones together use constant DEFAULT_JOB_COLOR_NAMES => ( 'bold green on_blue', 'bold blue on_white', 'bold black on_cyan', 'bold green on_bright_black', 'bold dark blue on_white', 'bold black on_green', 'bold cyan on_blue', 'bold black on_white', 'bold white on_cyan', 'bold cyan on_bright_black', 'bold white on_green', 'bold bright_black on_white', 'bold white on_blue', 'bold bright_cyan on_green', 'bold blue on_cyan', 'bold white on_bright_black', 'bold bright_black on_green', 'bold bright_green on_blue', 'bold bright_blue on_white', 'bold bright_white on_bright_black', 'bold yellow on_blue', 'bold bright_black on_cyan', 'bold bright_green on_bright_black', 'bold blue on_green', 'bold bright_cyan on_blue', 'bold bright_blue on_cyan', 'bold dark bright_white on_bright_black', 'bold bright_blue on_green', 'bold dark bright_blue on_white', 'bold bright_white on_blue', 'bold bright_cyan on_bright_black', 'bold bright_white on_cyan', 'bold bright_white on_green', 'bold bright_yellow on_blue', #'bold magenta on_white', #'bold dark magenta on_white', #'bold dark cyan on_white', 'bold dark bright_cyan on_bright_black', #'bold dark bright_green on_black', #'bold dark bright_yellow on_black', ); sub DEFAULT_JOB_COLOR() { return map { Term::ANSIColor::color($_) } DEFAULT_JOB_COLOR_NAMES; } sub DEFAULT_COLOR() { return ( reset => Term::ANSIColor::color('reset'), blob => Term::ANSIColor::color('bold bright_black on_white'), tree => Term::ANSIColor::color('bold bright_white'), tag_border => Term::ANSIColor::color('bold bright_white'), ); } my %FACET_TAG_BORDERS = ( 'default' => ['[', ']'], 'amnesty' => ['{', '}'], 'info' => ['(', ')'], 'error' => ['<', '>'], 'parent' => [' ', ' '], ); sub init { my $self = shift; $self->{+COMPOSER} ||= Test2::Formatter::Test2::Composer->new; $self->{+VERBOSE} = 1 unless defined $self->{+VERBOSE}; $self->{+JOB_LENGTH} ||= 2; my $io = $self->{+IO} = clone_io($self->{+IO} || \*STDOUT) or die "Cannot get a filehandle: $!"; $io->autoflush(1); $self->{+TTY} = -t $io unless defined $self->{+TTY}; my $use_color = ref($self->{+COLOR}) ? 1 : delete($self->{+COLOR}); $use_color = $self->{+TTY} unless defined $use_color; if ($use_color && USE_ANSI_COLOR) { $self->{+SHOW_BUFFER} = 1 unless defined $self->{+SHOW_BUFFER}; if ($use_color) { $self->{+COLOR} = { DEFAULT_COLOR(), TAGS => {DEFAULT_TAG_COLOR()}, FACETS => {DEFAULT_FACET_COLOR()}, JOBS => [DEFAULT_JOB_COLOR()], } unless defined $self->{+COLOR}; $self->{+JOB_COLORS} = {free => [@{$self->{+COLOR}->{JOBS}}]}; } } else { $self->{+SHOW_BUFFER} = 0 unless defined $self->{+SHOW_BUFFER}; } $self->{+ECOUNT} //= 0; my $reset = $use_color ? Term::ANSIColor::color('reset') : ''; my $cyan = $use_color ? Term::ANSIColor::color('cyan') : ''; $self->{+_ACTIVE_DISP} = ["[${cyan}INITIALIZING${reset}]", '']; $self->{+_FILE_STATS} = { passed => 0, failed => 0, running => 0, todo => 0, total => 0, }; } sub io { my $self = shift; my ($job_id) = @_; return $self->{+IO} unless defined $job_id; return $self->{+JOB_IO}->{$job_id} // $self->{+IO}; } sub encoding { my $self = shift; if (@_) { my ($enc, $job_id) = @_; if (defined $job_id) { my $io; unless ($io = $self->{+ENC_IO}->{$enc}) { $io = $self->{+ENC_IO}->{$enc} = clone_io($self->{+IO} || \*STDOUT) or die "Cannot get a filehandle: $!"; $io->autoflush(1); apply_encoding($io, $enc); } $self->{+JOB_IO}->{$job_id} = $io; } else { apply_encoding($self->{+IO}, $enc); } $self->{+_ENCODING} = $enc; } return $self->{+_ENCODING}; } if ($^C) { no warnings 'redefine'; *write = sub {}; } sub write { my ($self, $e, $num, $f) = @_; $f ||= $e->facet_data; my $should_show = $self->update_active_disp($f); $self->{+ECOUNT}++; my $job_id = $f->{harness}->{job_id}; $self->encoding($f->{control}->{encoding}, $job_id) if $f->{control}->{encoding}; my $hf = hub_truth($f); my $depth = $hf->{nested} || 0; return if $depth && (!$self->{+SHOW_BUFFER} || !$self->{+PROGRESS}); my $lines; if (!$self->{+VERBOSE}) { if ($depth) { $lines = []; } else { $lines = $self->render_quiet($f); } } elsif ($depth) { my $tree = $self->render_tree($f, '>'); $lines = $self->render_buffered_event($f, $tree); } else { my $tree = $self->render_tree($f,); $lines = $self->render_event($f, $tree); } $should_show ||= $lines && @$lines; unless ($should_show || $self->{+VERBOSE}) { if (my $last = $self->{last_rendered}) { return if time - $last < 0.2; $self->{last_rendered} = time; } else { $self->{last_rendered} = time; } } push @{$self->{+JOB_COLORS}->{free}} => delete $self->{+JOB_COLORS}->{used}->{$job_id} if $job_id && $f->{harness_job_end}; # Local is expensive! Only do it if we really need to. local($\, $,) = (undef, '') if $\ || $,; my $io = $self->io($job_id); if ($self->{+_BUFFERED}) { print $io "\r\e[K"; $self->{+_BUFFERED} = 0; } if (!$self->{+VERBOSE}) { print $io $_, "\n" for @$lines; if ($self->{+TTY} && $self->{+PROGRESS}) { print $io $self->render_status($f); $self->{+_BUFFERED} = 1; } } elsif ($depth && $lines && @$lines && !$self->{+INTERACTIVE}) { print $io $lines->[0]; $self->{+_BUFFERED} = 1; } else { print $io $_, "\n" for @$lines; } delete $self->{+JOB_IO}->{$job_id} if $job_id && $f->{harness_job_end}; } sub finalize { my $self = shift; my $io = $self->{+IO}; print $io "\r\e[K" if $self->{+_BUFFERED}; return; } sub step { my $self = shift; return unless $self->update_active_disp; my $io = $self->io(0); if ($self->{+_BUFFERED}) { print $io "\r\e[K"; $self->{+_BUFFERED} = 0; } if ($self->{+TTY} && $self->{+PROGRESS}) { print $io $self->render_status(); $self->{+_BUFFERED} = 1; } } sub update_active_disp { my $self = shift; my ($f) = @_; my $should_show = 0; my $stats = $self->{+_FILE_STATS}; my $out = 0; $out = $self->update_spinner($stats) unless $stats->{started}; return $out unless $f; if (my $task = $f->{harness_job_queued}) { $self->{+JOB_NAMES}->{$task->{job_id}} = $task->{job_name} || $task->{job_id}; $stats->{total}++; $stats->{todo}++; } if ($f->{harness_job_launch}) { my $job = $f->{harness_job}; $self->{+ACTIVE_FILES}->{File::Spec->abs2rel($job->{file})} = $job->{job_name} || $job->{job_id}; $should_show = 1; $stats->{running}++; $stats->{todo}--; $stats->{started} //= 1; } if ($f->{harness_job_end}) { my $file = $f->{harness_job_end}->{file}; delete $self->{+ACTIVE_FILES}->{File::Spec->abs2rel($file)}; $should_show = 1; $stats->{running}--; if ($f->{harness_job_end}->{fail}) { $stats->{failed}++; } else { $stats->{passed}++; } } return $out unless $should_show; my $statline = join '|' => ( $self->_highlight($stats->{passed}, 'P', 'green'), $self->_highlight($stats->{failed}, 'F', 'red'), $self->_highlight($stats->{running}, 'R', 'cyan'), $self->_highlight($stats->{todo}, 'T', 'yellow'), ); $statline = "[$statline]"; my $active = $self->{+ACTIVE_FILES}; return $self->{+_ACTIVE_DISP} = [$statline, ''] unless $active && keys %$active; my $reset = $self->reset; my $str .= "("; { no warnings 'numeric'; $str .= join(' ' => map { m{([^/]+)$}; "$active->{$_}:$1" } sort { ($active->{$a} || 0) <=> ($active->{$b} || 0) or $a cmp $b } keys %$active); } $str .= ")"; $self->{+_ACTIVE_DISP} = [$statline, $str]; return 1; } sub update_spinner { my $self = shift; my ($stats) = @_; $stats->{spinner} //= '|'; $stats->{spinner_time} //= time - 1; $stats->{blink_time} //= time - 1; $stats->{blink} //= ''; if (time - $stats->{spinner_time} > 0.1) { $stats->{spinner_time} = time; my $start = substr($stats->{spinner}, 0, 1); $stats->{spinner} = '\\' if $start eq '-'; $stats->{spinner} = '-' if $start eq '/'; $stats->{spinner} = '/' if $start eq '|'; $stats->{spinner} = '|' if $start eq '\\'; } elsif(time - $stats->{blink_time} > 0.5) { $stats->{blink_time} = time; $stats->{blink} = $stats->{blink} ? '' : 'bold bright_'; } else { return 0; } my $yellow = $self->{+COLOR} ? Term::ANSIColor::color($stats->{blink} . 'yellow') : ''; my $cyan = $self->{+COLOR} ? Term::ANSIColor::color('cyan') : ''; my $green = $self->{+COLOR} ? Term::ANSIColor::color('bold bright_green') : ''; my $bold = $self->{+COLOR} ? Term::ANSIColor::color('bold bright_white') : ''; my $reset = $self->reset; $self->{+_ACTIVE_DISP} = [ join( '' => ( $bold => "[ ", $reset, $green => $stats->{spinner}, $reset, '' => " ", $self->{+IS_PERSISTENT} ? ( $yellow => "Waiting for busy runner", $reset, '' => " ", $reset => "(see ", $reset, $cyan => "yath status", $reset, $reset => ")", $reset, ) : ($yellow => "INITIALIZING", $reset), '' => " ", $green => $stats->{spinner}, $reset, $bold => " ]", $reset, ) ), '', ]; return 1; } sub _highlight { my $self = shift; my ($val, $label, $color) = @_; return "${label}:${val}" unless $val && $self->{+COLOR}; return sprintf('%s%s:%d%s', Term::ANSIColor::color($color), $label, $val, $self->reset); } sub colorstrip { my $self = shift; my ($str) = @_; return $str unless USE_ANSI_COLOR; return Term::ANSIColor::colorstrip($str); } sub render_status { my $self = shift; my $reset = $self->reset; my $cyan = $self->{+COLOR} ? Term::ANSIColor::color('cyan') : ''; my $str = "$self->{+_ACTIVE_DISP}->[0] Events: $self->{+ECOUNT} ${cyan}$self->{+_ACTIVE_DISP}->[1]${reset}"; my $max = term_size() || 80; if (length($str) > $max) { my $nocolor = $self->colorstrip($str); $str = substr($nocolor, 0, $max - 8) . " ...)$reset" if length($nocolor) > $max; $str =~ s/\(/$cyan(/; $str =~ s/^\[[^\]]+\]/$self->{+_ACTIVE_DISP}->[0]/; } return $str; } sub render_buffered_event { my $self = shift; my ($f, $tree) = @_; my $comp = $self->{+COMPOSER}->render_one_line($f) or return; return unless @$comp; return [$self->build_line($tree, @$comp)]; } sub render_event { my $self = shift; my ($f, $tree) = @_; my $comps = $self->{+COMPOSER}->render_verbose($f); my (@parent, @times); if ($f->{parent}) { @parent = $self->render_parent($f, $tree); if (@$comps && $comps->[-1]->[0] eq 'times') { my $times = pop(@$comps); @times = $self->build_line($tree, @$times); } } my @out; for my $comp (@$comps) { my $ctree = $tree; substr($ctree, -2, 2, '+~') if $comp->[0] eq 'assert' && $f->{parent}; push @out => $self->build_line($ctree, @$comp); } push @out => (@parent, @times); return \@out; } sub render_quiet { my $self = shift; my ($f, $tree) = @_; my @out; my $comps = $self->{+COMPOSER}->render_brief($f); for my $comp (@$comps) { my $ctree = $tree ||= $self->render_tree($f); substr($ctree, -2, 2, '+~') if $comp->[0] eq 'assert' && $f->{parent}; push @out => $self->build_line($ctree, @$comp); } if ($f->{parent} && !$f->{amnesty}) { push @out => $self->render_parent($f, $tree ||= $self->render_tree($f), quiet => 1); } return \@out; } sub reset { my $self = shift; return $self->{+COLOR} ? $self->{+COLOR}->{reset} : ''; } sub job_color { my $self = shift; my ($id, $set) = @_; return '' unless $self->{+JOB_COLORS}; return $self->{+JOB_COLORS}->{used}->{$id} || '' unless $set; return $self->{+JOB_COLORS}->{used}->{$id} ||= shift @{$self->{+JOB_COLORS}->{free}} || ''; } sub render_tree { my $self = shift; my ($f, $char) = @_; $char ||= '|'; my $job = ''; if ($f->{harness} && $f->{harness}->{job_id}) { my $id = $f->{harness}->{job_id}; my $name = $self->{+JOB_NAMES}->{$id}; my ($color, $reset) = ('', ''); if ($self->{+JOB_COLORS}) { $color = $self->job_color($id, 'set'); $reset = $self->reset; } my $len = length($name); if (!$self->{+JOB_LENGTH} || $len > $self->{+JOB_LENGTH}) { $self->{+JOB_LENGTH} = $len; } else { $len = $self->{+JOB_LENGTH}; } $job = sprintf("%sjob %${len}s%s ", $color, $name, $reset || ''); } my $hf = hub_truth($f); my $depth = $hf->{nested} || 0; my @pipes = (' ', map $char, 1 .. $depth); return join(' ' => $job, @pipes) . ' '; } sub build_line { my $self = shift; my ($tree, $facet, $tag, $text) = @_; $tree ||= ''; $tag ||= ''; $text ||= ''; chomp($text); substr($tree, -2, 1, '+') if $facet eq 'assert'; $tag = substr($tag, 0 - TAG_WIDTH, TAG_WIDTH) if length($tag) > TAG_WIDTH; my $max = $self->{+TTY} && !$self->{+NO_WRAP} ? (term_size() || 80) : undef; my $color = $self->{+COLOR}; my $reset = $self->reset; my $tcolor = $color ? $color->{TAGS}->{$tag} || $color->{FACETS}->{$facet} || '' : ''; my ($ps, $pe) = @{$FACET_TAG_BORDERS{$facet} || $FACET_TAG_BORDERS{default}}; $tag = uc($tag); my $length = length($tag); if ($length > TAG_WIDTH) { $tag = substr($tag, 0, TAG_WIDTH); } elsif($length < TAG_WIDTH) { my $pad = (TAG_WIDTH - $length) / 2; my $padl = $pad + (TAG_WIDTH - $length) % 2; $tag = (' ' x $padl) . $tag . (' ' x $pad); } my $start; if ($color) { my $border = $color->{tag_border} || ''; $start = "${reset}${border}${ps}${reset}${tcolor}${tag}${reset}${border}${pe}${reset}"; } else { $start = "${ps}${tag}${pe}"; } $start .= " "; if ($tree) { if ($color) { my $trcolor = $color->{tree} || ''; $start .= $trcolor . $tree . $reset; } else { $start .= $tree; } } my @lines = split /[\r\n]/, $text; @lines = ($text) unless @lines; my @out; for my $line (@lines) { if(@lines > 1 && $max && length("$ps$tag$pe $tree$line") > $max) { @out = (); last; } if ($color) { push @out => "${start}${tcolor}${line}$reset"; } else { push @out => "${start}${line}"; } } return @out if @out; return ( "$start----- START -----", $text, "$start------ END ------", ) unless $color; my $blob = $color->{blob} || ''; return ( "$start${blob}----- START -----$reset", "${tcolor}${text}${reset}", "$start${blob}------ END ------$reset", ); } sub render_parent { my $self = shift; my ($f, $tree, %params) = @_; my $meth = $params{quiet} ? 'render_quiet' : 'render_event'; my @out; for my $sf (@{$f->{parent}->{children}}) { $sf->{harness} ||= $f->{harness}; my $tree = $self->render_tree($sf); push @out => @{$self->$meth($sf, $tree)}; } return unless @out; push @out => ( $self->build_line("$tree^", 'parent', '', ''), ); return @out; } sub DESTROY { my $self = shift; my $io = $self->{+IO} or return; # Local is expensive! Only do it if we really need to. local($\, $,) = (undef, '') if $\ || $,; print $io Term::ANSIColor::color('reset') if USE_ANSI_COLOR; print $io "\n"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Formatter::Test2 - An alternative to TAP, used by Test2::Harness. =head1 DESCRIPTION This formatter is the primary formatter used for final result rendering when you use Test2::Harness. This formatter is NOT designed to have its output consumed by code/machine/harnesses. The goal of this formatter is to have output that is easily read by humans. =head1 SYNOPSIS If you are running a test directly with perl and want to use this formatter: $ perl -MTest2::Formatter::Test2 path/to/test.t You could also use the module directly in your test, but that is not recommended as your test would then be unable to be run via prove or other harnesses. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Formatter/QVF.pm0000644000175000017500000000527215012417054021003 0ustar exodistexodistpackage Test2::Formatter::QVF; use strict; use warnings; our $VERSION = '1.000158'; BEGIN { require Test2::Formatter::Test2; our @ISA = qw(Test2::Formatter::Test2) } use Test2::Util::HashBase qw{ -job_buffers -real_verbose }; sub init { my $self = shift; $self->SUPER::init(); $self->{+REAL_VERBOSE} = $self->{+VERBOSE}; $self->{+VERBOSE} ||= 100; } sub update_active_disp { my $self = shift; my ($f) = @_; return if $f && $f->{__RENDER__}->{update_active_disp}++; $self->SUPER::update_active_disp($f); } sub write { my ($self, $e, $num, $f) = @_; return $self->SUPER::write($e, $num, $f) if $self->{+REAL_VERBOSE}; $f ||= $e->facet_data; my $job_id = $f->{harness}->{job_id}; push @{$self->{+JOB_BUFFERS}->{$job_id}} => [$e, $num, $f] if $job_id; my $show = $self->update_active_disp($f); if ($f->{harness_job_end} || !$job_id) { $show = 1; my $buffer = delete $self->{+JOB_BUFFERS}->{$job_id}; if($f->{harness_job_end}->{fail}) { $self->SUPER::write(@{$_}) for @$buffer; } else { $f->{info} = [grep { $_->{tag} ne 'TIME' } @{$f->{info}}] if $f->{info}; $self->SUPER::write($e, $num, $f) } } $self->{+ECOUNT}++; return unless $self->{+TTY}; return unless $self->{+PROGRESS}; $show ||= 1 unless $self->{+ECOUNT} % 10; if ($show) { # Local is expensive! Only do it if we really need to. local($\, $,) = (undef, '') if $\ || $,; my $io = $self->{+IO}; if ($self->{+_BUFFERED}) { print $io "\r\e[K"; $self->{+_BUFFERED} = 0; } print $io $self->render_status($f); $self->{+_BUFFERED} = 1; } return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Formatter::QVF - Test2 formatter that is [Q]uiet but [V]erbose on [F]ailure. =head1 DESCRIPTION This formatter is a subclass of L. This one will buffer all output from a test file and only show it to you if there is a failure. Most of the time it willonly show you the completion notifications for each test. =head1 SYNOPSIS $ yath test --qvf ... =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/0000755000175000017500000000000015012417054017443 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Log/0000755000175000017500000000000015012417054020164 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Log/CoverageAggregator/0000755000175000017500000000000015012417054023722 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Log/CoverageAggregator/ByTest.pm0000644000175000017500000001121015012417054025465 0ustar exodistexodistpackage Test2::Harness::Log::CoverageAggregator::ByTest; use strict; use warnings; our $VERSION = '1.000158'; use Scalar::Util qw/blessed/; use Test2::Harness::Util qw/mod2file/; use parent 'Test2::Harness::Log::CoverageAggregator'; use Test2::Harness::Util::HashBase qw/SUPER::init(); $self->{+IN_PROGRESS} //= {}; $self->{+COMPLETED} //= []; } sub start_test { my $self = shift; my ($test) = @_; $self->{+IN_PROGRESS}->{$test} //= {test => $test, files => {}, aggregator => blessed($self)}; } sub stop_test { my $self = shift; my ($test) = @_; push @{$self->{+COMPLETED}} => delete $self->{+IN_PROGRESS}->{$test}; } sub record_coverage { my $self = shift; my ($test, $data) = @_; if (my $manager = $data->{from_manager}) { $self->{+IN_PROGRESS}->{$test}->{manager} = $manager; } } sub touch { my $self = shift; my %params = @_; my $file = $params{source}; my $sub = $params{sub}; my $test = $params{test}; my $mdata = $params{manager_data}; my $set = $self->{+IN_PROGRESS}->{$test}->{files}->{$file}->{$sub} //= []; return unless $mdata; my $type = ref $mdata; if ($type eq 'ARRAY') { if (@$set) { my %seen; @$set = grep { !$seen{$_}++ } @$set, @$mdata; } else { push @$set => @$mdata; } } else { push @$set => $mdata; } } sub flush { my $self = shift; my $data = $self->{+COMPLETED} //= []; return unless @$data; $self->{+COMPLETED} = []; return $data; } sub finalize { my $self = shift; my $ip = $self->{+IN_PROGRESS}; my $cm = $self->{+COMPLETED} //= []; push @{$cm} => {$_ => delete $ip->{$_}} for keys %$ip; $self->SUPER::finalize(); } sub get_coverage_tests { my $class = shift; my ($settings, $changes, $coverage_data) = @_; my $test = $coverage_data->{test} // return; my $filemap = $coverage_data->{files} // {}; my $manager = $coverage_data->{manager} // undef; my ($changes_exclude_loads, $changes_exclude_opens); if ($settings->check_prefix('finder')) { my $finder = $settings->finder; $changes_exclude_loads = $finder->changes_exclude_loads; $changes_exclude_opens = $finder->changes_exclude_opens; } my %froms; for my $file (keys %$changes) { my $parts_map = $changes->{$file}; my $parts_list = [keys %$parts_map]; my $use_parts; if (!@$parts_list || $parts_map->{'*'}) { $use_parts = [keys %{$filemap->{$file}}]; } else { $use_parts = $parts_list; } my %seen; for my $part (@$use_parts) { next if $seen{$part}++; my $cfroms = $filemap->{$file}->{$part} or next; push @{$froms{subs}} => @{$cfroms}; } unless ($changes_exclude_loads) { if (my $lfroms = $filemap->{$file}->{'*'}) { push @{$froms{loads}} => @{$lfroms}; } } unless ($changes_exclude_opens) { if (my $ofroms = $filemap->{$file}->{'<>'}) { push @{$froms{opens}} => @{$ofroms}; } } } # Nothing to do for this test return unless keys %froms; # In these cases we have no choice but to run the entire file return ($test) unless $manager; my @out; my $ok = eval { require(mod2file($manager)); my $specs = $manager->test_parameters($test, \%froms, $changes, $coverage_data, $settings); $specs = { run => $specs } unless ref $specs; push @out => [$test, $specs] unless defined $specs->{run} && !$specs->{run}; # Intentional skip 1; }; my $err = $@; return @out if $ok; warn "Error processing coverage data for '$test' using manager '$manager'. Running entire test to be safe.\nError:\n====\n$@\n====\n"; return ($test); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Log::CoverageAggregator::ByTest - Aggregate coverage by test =head1 DESCRIPTION =head1 SYNOPSIS =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Log/CoverageAggregator/ByRun.pm0000644000175000017500000001241715012417054025324 0ustar exodistexodistpackage Test2::Harness::Log::CoverageAggregator::ByRun; use strict; use warnings; our $VERSION = '1.000158'; use Scalar::Util qw/blessed/; use Test2::Harness::Util qw/mod2file/; use parent 'Test2::Harness::Log::CoverageAggregator'; use Test2::Harness::Util::HashBase qw/{+COVERAGE} //= {aggregator => blessed($self)}; } sub record_coverage { my $self = shift; my ($test, $data) = @_; my $coverage = $self->{+COVERAGE} // $self->init_coverage; my $files = $coverage->{files} //= {}; my $alltestmeta = $coverage->{testmeta} //= {}; my $testmeta = $alltestmeta->{$test} //= {type => 'flat'}; if (my $type = $data->{test_type}) { $testmeta->{type} = $type; } if (my $manager = $data->{from_manager}) { $testmeta->{manager} = $manager; } } sub touch { my $self = shift; my %params = @_; my $file = $params{source}; my $sub = $params{sub}; my $test = $params{test}; my $mdata = $params{manager_data}; my $coverage = $self->{+COVERAGE} // $self->init_coverage; my $files = $coverage->{files} //= {}; my $set = $files->{$file}->{$sub}->{$test} //= []; return unless $mdata; my $type = ref $mdata; if ($type eq 'ARRAY') { my %seen; @$set = grep { !$seen{$_}++ } @$set, @$mdata; } else { push @$set => $mdata; } } sub record_metrics { my $self = shift; my ($metrics) = @_; my $coverage = $self->{+COVERAGE} // $self->init_coverage; $coverage->{untested} = $metrics->{untested}; $coverage->{metrics} = {files => $metrics->{files}, subs => $metrics->{subs}}; } sub flush { my $self = shift; return unless $self->{+FINALIZED}; return [ $self->{+COVERAGE} // $self->init_coverage ]; } sub finalize { my $self = shift; $self->{+FINALIZED} = 1; $self->SUPER::finalize(); } sub get_coverage_tests { my $class = shift; my ($settings, $changes, $coverage_data) = @_; my $filemap = $coverage_data->{files} // {}; my $testmeta = $coverage_data->{testmeta} // {}; my ($changes_exclude_loads, $changes_exclude_opens); if ($settings->check_prefix('finder')) { my $finder = $settings->finder; $changes_exclude_loads = $finder->changes_exclude_loads; $changes_exclude_opens = $finder->changes_exclude_opens; } my %tests; for my $file (keys %$changes) { my $parts_map = $changes->{$file}; my $parts_list = [keys %$parts_map]; my $use_parts; if (!@$parts_list || $parts_map->{'*'}) { $use_parts = [keys %{$filemap->{$file}}]; } else { $use_parts = $parts_list; } my %seen; for my $part (@$use_parts) { next if $seen{$part}++; my $ctests = $filemap->{$file}->{$part} or next; for my $test (keys %$ctests) { push @{$tests{$test}->{subs}} => @{$ctests->{$test}}; } } unless ($changes_exclude_opens) { if (my $ltests = $filemap->{$file}->{'*'}) { for my $test (keys %$ltests) { push @{$tests{$test}->{loads}} => @{$ltests->{$test}}; } } } unless ($changes_exclude_loads) { if (my $otests = $filemap->{$file}->{'<>'}) { for my $test (keys %$otests) { push @{$tests{$test}->{opens}} => @{$otests->{$test}}; } } } } my @out; for my $test (sort keys %tests) { my $meta = $testmeta->{$test} // {type => 'flat'}; my $type = $meta->{type}; my $manager = $meta->{manager}; # In these cases we have no choice but to run the entire file if ($type eq 'flat' || !$manager) { push @out => $test; next; } die "Invalid test type: $type" unless $type eq 'split'; my $froms = $tests{$test} // []; my $ok = eval { require(mod2file($manager)); my $specs = $manager->test_parameters($test, $froms, $changes, $coverage_data, $settings); $specs = { run => $specs } unless ref $specs; push @out => [$test, $specs] unless defined $specs->{run} && !$specs->{run}; # Intentional skip 1; }; my $err = $@; next if $ok; warn "Error processing coverage data for '$test' using manager '$manager'. Running entire test to be safe.\nError:\n====\n$@\n====\n"; push @out => $test; } return @out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Log::CoverageAggregator::ByRun - Aggregate test data by run =head1 DESCRIPTION =head1 SYNOPSIS =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Log/CoverageAggregator.pm0000644000175000017500000002353215012417054024265 0ustar exodistexodistpackage Test2::Harness::Log::CoverageAggregator; use strict; use warnings; our $VERSION = '1.000158'; use File::Find qw/find/; use Test2::Harness::Util::HashBase qw/{+TOUCHED} //= {}; $self->{+JOB_MAP} //= {}; $self->{+CAN_TOUCH} = !!$self->can('touch'); $self->{+CAN_START_TEST} = !!$self->can('start_test'); $self->{+CAN_STOP_TEST} = !!$self->can('stop_test'); $self->{+CAN_RECORD_COVERAGE} = !!$self->can('record_coverage'); if (my $file = $self->{+FILE}) { open(my $fh, '>', $file) or die "Could not open file '$file' for writing: $!"; $self->{+IO} = $fh; } } sub flush { } sub finalize { $_[0]->write } sub record_metrics { } sub write { my $self = shift; my $list = $self->flush() or return; my $io = $self->{+IO} or return $list; my $encode = $self->{+ENCODE}; for my $item (@$list) { my $encoded = $encode ? $encode->($item) : $item; print $io $encoded; } return $list; } sub process_event { my $self = shift; my ($e) = @_; return unless $e; return unless keys %$e; my $job_map = $self->{+JOB_MAP} //= {}; my $job_id = $e->{job_id} // 0; my $test = $job_map->{$job_id}; if (my $start = $e->{facet_data}->{harness_job_start}) { $test //= $start->{rel_file}; $self->start_test($test, $e) if $self->{+CAN_START_TEST}; } if (my $end = $e->{facet_data}->{harness_job_end}) { $test //= $end->{rel_file}; $self->stop_test($test, $e) if $self->{+CAN_STOP_TEST}; } $job_map->{$job_id} //= $test if $test; if (my $c = $e->{facet_data}->{coverage}) { die "Got coverage data before test start! (Weird event order?)" unless $test; $self->_touch_coverage($test, $c, $e); $self->record_coverage($test, $c, $e) if $self->{+CAN_RECORD_COVERAGE}; } return $self->write(); } sub _touch_coverage { my $self = shift; my ($test, $data, $e) = @_; if (my $new = $data->{files}) { for my $file (keys %$new) { my $ndata = $new->{$file} // next; for my $sub (keys %$ndata) { $self->{+TOUCHED}->{$file}->{$sub}++; next unless $self->{+CAN_TOUCH}; $self->touch(source => $file, sub => $sub, test => $test, manager_data => $ndata->{$sub}, event => $e); } } } } my %PERL_TYPES = ( pl => 1, pm => 1, t => 1, tx => 1, t2 => 1, pmc => 1, ); sub build_metrics { my $self = shift; my %params = @_; my $private = $params{exclude_private}; my $dirs = $params{dirs} // ['lib']; my $types = $params{types} // ['pm', 'pl']; my $touched = $self->{+TOUCHED} //= {}; my $metrics = { files => {total => 0, tested => 0}, subs => {total => 0, tested => 0}, untested => {files => [], subs => {}}, }; my $untested = $metrics->{untested}; my %type_check = map { m/\.?([^\.]+)$/g; (lc($1) => 1) } @$types; my $raw_untested = {}; find( { no_chdir => 1, wanted => sub { my $type = lc($_); $type =~ s/^.*\.([^\.]+)$/$1/; return unless $type_check{$type}; $metrics->{files}->{total}++; my $file = $File::Find::name; my $cfile = $touched->{$file}; if ($cfile) { $metrics->{files}->{tested}++ } else { push @{$untested->{files}} => $file; } for my $sub ($PERL_TYPES{$type} ? $self->scan_subs($file) : ('<>')) { next if $sub =~ m/^_/ && $private; my $special_sub = $sub !~ m/^\w/; $metrics->{subs}->{total}++ unless $special_sub; if ($cfile && $cfile->{$sub}) { $metrics->{subs}->{tested}++ unless $special_sub; } else { $raw_untested->{$file}->{$sub} = 1; } } }, }, @$dirs ); for my $file (keys %$raw_untested) { my @val = keys %{$raw_untested->{$file}}; next unless @val; if (@val == 1 && $val[0] eq '<>') { push @{$untested->{files}} => $file; } else { $untested->{subs}->{$file} = [sort @val]; } } my %seen; @{$untested->{files}} = sort grep { !$seen{$_}++ } @{$untested->{files}}; $self->record_metrics($metrics); return $metrics; } sub scan_subs { my $self = shift; my ($file) = @_; my @subs; my $fh; unless (open($fh, '<', $file)) { warn "Could not open file '$file': $!"; return; } my $in_pod = 0; while (my $line = <$fh>) { $in_pod = 1 if $line =~ m/^=\w/; if ($in_pod) { next unless $line =~ m/^=cut/i; $in_pod = 0; next; } last if $line =~ m/^__(END|DATA)__$/; next unless $line =~ m/^\s*sub\s+(\w+)/; push @subs => $1; } return @subs; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Log::CoverageAggregator - Module for aggregating coverage data from a stream of events. =head1 DESCRIPTION This module takes a stream of events and produces aggregated coverage data. =head1 SYNOPSIS use Test2::Harness::Log::CoverageAggregator; my $agg = Test2::Harness::Log::CoverageAggregator->new(); while (my $e = $log->next_event) { $agg->process_event($e); } # Get a structure like { source_file => { source_method => $touched_count, ... }, ...} my $touched_source = $agg->touched; # Get a structure like # { # files => {total => 5, tested => 2}, # subs => {total => 20, tested => 12}, # untested => {files => \@file_list, subs => {file => \@sub_list, ...}}, # } my $metrics = $agg->metrics; =head1 METHODS =head2 IMPLEMENTABLE IN SUBLCASSES If you implement these in a subclass they will be called for you at the proper times, making subclassing much easier. In most cases you can avoid overriding process_event(). =over 4 =item $agg->start_test($test, $event) This is called once per test when it starts. B If a test is run more than once (re-run) it will start and stop again for each re-run. The event is also provided as an argument so that you can check for a try-id or similar in the event that re-runs matter to you. =item $agg->stop_test($test, $event) This is called once per test when it stops. B If a test is run more than once (re-run) it will start and stop again for each re-run. The event is also provided as an argument so that you can check for a try-id or similar in the event that re-runs matter to you. =item $agg->record_coverage($test, $coverage_data, $event) This is called once per coverage event (there can be several in a test, specially if it forks or uses threads). In most cases you probably want to leave this unimplemented and implement the C method instead of iterating over the coverage structure yourself. =item $agg->touch(source => $file, sub => $sub, test => $test, manager_data => $mdata, event => $event) Every touch applied to a source file (and sub) will trigger this method call. =over 4 =item source => $file The source file that was touched =item sub => $sub The source subroutine that was touched. B This may be '<>' if the source file was opened via C or '*' if code outside of a subroutine was executed by the test. =item test => $test The test file that did the touching. =item manager_data => $mdata If the test file makes use of a source manager to attach extra data to coverage, this is where that data will be. A good example would be test suites that use tools similar to Test::Class or Test::Class::Moose where all tests are run in methods and you want to track what test method does the touching. Please note that this level of coverage tracking is not automatic. =item event => $event The full event being processed. =back =back =head2 PUBLIC API =over 4 =item $agg->process_event($event) Process the event, aggregating any coverage info it may contain. =item $touched = $add->touched() Returns the following structure, which tells you how many times a specific source file's subroutines were called. There are also "special" subroutines '<>' and '*' which mean "file was opened via open" and "code outside of a subroutine". { source_file => { source_method => $touched_count, ... }, ... } =item $metrics = $agg->build_metrics() =item $metrics = $agg->build_metrics(exclude_private => $BOOL) Will build metrics, and include them in the output from C<< $agg->coverage() >> next time it is called. The C option, when set to true, will exclude any method that beings with an underscore from the coverage metrics and untested sub list. Metrics: { files => {total => 20, tested => 18}, subs => {total => 80, tested => 70}, untested => { files => \@file_list, subs => { file => \@sub_list, ... } }, } =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Renderer/0000755000175000017500000000000015012417054021211 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Renderer/Formatter.pm0000644000175000017500000001260415012417054023515 0ustar exodistexodistpackage Test2::Harness::Renderer::Formatter; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use File::Spec; use Storable qw/dclone/; use Test2::Harness::Util qw/fqmod mod2file/; use Test2::Harness::Util::JSON qw/encode_pretty_json/; BEGIN { require Test2::Harness::Renderer; our @ISA = ('Test2::Harness::Renderer') } use Test2::Harness::Util::HashBase qw{ -io -io_err -formatter -show_run_info -show_job_info -show_job_launch -show_job_end -do_step -interactive }; sub init { my $self = shift; my $settings = $self->{+SETTINGS}; my $formatter = $self->{+FORMATTER} //= 'Test2'; my $f_class = fqmod('Test2::Formatter', $formatter); my $f_file = mod2file($f_class); require $f_file; my $io = $self->{+IO} || $self->{output} || \*STDOUT; unless (ref $io) { open(my $fh, '>', $io) or die "Could not open file '$io' for writing: $!"; $self->{+IO} = $fh; } my $io_err = $self->{+IO_ERR} || $self->{output} || \*STDERR; unless (ref $io_err) { open(my $fh, '>', $io_err) or die "Could not open file '$io_err' for writing: $!"; $self->{+IO_ERR} = $fh; } $self->{+INTERACTIVE} = 1 if $settings->debug->interactive; $self->{+INTERACTIVE} //= 1 if $ENV{YATH_INTERACTIVE}; $self->{+FORMATTER} = $f_class->new( io => $self->{+IO}, progress => $self->{+PROGRESS}, handles => [$self->{+IO}, $self->{+IO_ERR}, $self->{+IO}], verbose => $settings->display->verbose, color => $settings->display->color, no_wrap => $settings->display->no_wrap, interactive => $self->{+INTERACTIVE}, is_persistent => $self->{+COMMAND_CLASS}->group eq 'persist' ? 1 : 0, ); $self->{+DO_STEP} = $self->{+FORMATTER}->can('step') ? 1 : 0; $self->{+SHOW_JOB_END} = 1 unless defined $self->{+SHOW_JOB_END}; } sub step { my $self = shift; return unless $self->{+DO_STEP}; $self->{+FORMATTER}->step; } sub render_event { my $self = shift; my ($event) = @_; # We modify the event, which would be bad if there were multiple renderers, # so we deep clone it. $event = dclone($event); my $settings = $self->{+SETTINGS}; my $f = $event->{facet_data}; # Optimization $f->{harness} = {%$event}; delete $f->{harness}->{facet_data}; if ($self->{+SHOW_RUN_INFO} && $f->{harness_run}) { my $run = $f->{harness_run}; push @{$f->{info}} => { tag => 'RUN INFO', details => encode_pretty_json($run), }; } if ($f->{harness_job_launch}) { my $job = $f->{harness_job}; $f->{harness}->{job_id} ||= $job->{job_id}; if ($self->{+SHOW_JOB_LAUNCH}) { push @{$f->{info}} => { tag => $f->{harness_job_launch}->{retry} ? 'RETRY' : 'LAUNCH', debug => 0, important => 1, details => File::Spec->abs2rel($job->{file}), }; } if ($self->{+SHOW_JOB_INFO}) { push @{$f->{info}} => { tag => 'JOB INFO', details => encode_pretty_json($job), }; } } if ($f->{harness_job_end}) { my $job = $f->{harness_job}; my $skip = $f->{harness_job_end}->{skip}; my $fail = $f->{harness_job_end}->{fail}; my $file = $f->{harness_job_end}->{file}; my $retry = $f->{harness_job_end}->{retry}; my $job_id = $f->{harness}->{job_id} ||= $job->{job_id}; # Make the times important if they were requested if ($settings->display->show_times && $f->{info}) { for my $info (@{$f->{info}}) { next unless $info->{tag} eq 'TIME'; $info->{important} = 1; } } if ($self->{+SHOW_JOB_END}) { my $name = File::Spec->abs2rel($file); $name .= " - $skip" if $skip; my $tag = 'PASSED'; $tag = 'SKIPPED' if $skip; $tag = 'FAILED' if $fail; $tag = 'TO RETRY' if $retry; unshift @{$f->{info}} => { tag => $tag, debug => $fail, important => 1, details => $name, }; } } my $num = $f->{assert} && $f->{assert}->{number} ? $f->{assert}->{number} : undef; $self->{+FORMATTER}->write($event, $num, $f); } sub finish { my $self = shift; $self->{+FORMATTER}->finalize(); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Renderer::Formatter - Renderer that uses any Test2::Formatter for rendering. =head1 DESCRIPTION This renderer simply acts as a communication layer between the harness and any Test2 formatter that you wish to use to display results. Not all formatters will produce useful output for harness events. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Collector/0000755000175000017500000000000015012417054021371 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Collector/TapParser.pm0000644000175000017500000002112115012417054023625 0ustar exodistexodistpackage Test2::Harness::Collector::TapParser; use strict; use warnings; our $VERSION = '1.000158'; use Importer 'Importer' => 'import'; our @EXPORT_OK = qw{ parse_stdout_tap parse_stderr_tap parse_tap_line }; sub parse_stdout_tap { my ($line) = @_; my $facet_data = __PACKAGE__->_parse_tap_line($line) or return undef; $facet_data->{from_tap} = { source => 'STDOUT', details => $line }; return $facet_data; } sub parse_stderr_tap { my ($line) = @_; # STDERR only has comments return unless $line =~ m/^\s*#/; my $facet_data = __PACKAGE__->_parse_tap_line($line) or return undef; $facet_data->{info}->[-1]->{tag} = 'DIAG'; $facet_data->{info}->[-1]->{debug} = 1; $facet_data->{from_tap} = { source => 'STDERR', details => $line }; return $facet_data; } sub parse_tap_line { my ($line) = @_; return __PACKAGE__->_parse_tap_line($line); } sub _parse_tap_line { my $class = shift; my ($line) = @_; chomp($line); my ($lead, $lead_len, $nest, $str) = ('', 0, 0, $line); if ($line =~ m/^(\s+)\S/) { $lead = $1; $str =~ s/^\Q$lead\E//mg; $lead =~ s/\t/ /g; $lead_len = length($lead); # indentation other than 0 or a multiple of 4 spaces... not an event return undef if $lead_len % 4; $nest = $lead_len / 4; } my @types = qw/buffered_subtest comment plan bail version/; for my $type (@types) { my $sub = "parse_tap_$type"; my $facet_data = $class->$sub($str) or next; $facet_data->{trace}->{nested} = $nest; $facet_data->{hubs}->[0]->{nested} = $nest; return $facet_data; } return undef; } sub parse_tap_buffered_subtest { my $class = shift; my ($line) = @_; # End of a buffered subtest. return {parent => {}, harness => {subtest_end => 1}} if $line =~ m/^\}\s*$/; my $facet_data = $class->parse_tap_ok($line) or return undef; return $facet_data unless $facet_data->{assert}->{details} =~ s/\s*\{\s*$//g; $facet_data->{parent} = { details => $facet_data->{assert}->{details}, }; $facet_data->{harness}->{subtest_start} = 1; return $facet_data; } sub parse_tap_ok { my $class = shift; my ($line) = @_; my ($pass, $todo, $skip, $num, @errors); return undef unless $line =~ s/^(not )?ok\b//; $pass = !$1; push @errors => "'ok' is not immediately followed by a space." if $line && !($line =~ m/^ /); if ($line =~ s/^(\s*)(\d+)\b//) { my $space = $1; $num = $2; push @errors => "Extra space after 'ok'" if length($space) > 1; } # Not strictly compliant, but compliant with what Test-Simple does... # Standard does not have a todo & skip. if ($line =~ s/#\s*(todo & skip|todo|skip)(.*)$//i) { my ($directive, $reason) = ($1, $2); push @errors => "No space before the '#' for the '$directive' directive." unless $line =~ s/\s+$//; push @errors => "No space between '$directive' directive and reason." if $reason && !($reason =~ s/^\s+//); $skip = $reason if $directive =~ m/skip/i; $todo = $reason if $directive =~ m/todo/i; } # Standard says that everything after the ok (except the number) is part of # the name. Most things add a dash between them, and I am deviating from # standards by stripping it and surrounding whitespace. $line =~ s/\s*-\s*//; $line =~ s/^\s+//; $line =~ s/\s+$//; my $is_subtest = ($line =~ m/^Subtest:\s*(.*)$/) ? ($1 or 1) : undef; my $facet_data = { assert => { pass => $pass, no_debug => 1, details => $line, defined $num ? (number => $num) : (), }, }; $facet_data->{parent} = { details => $is_subtest, } if defined $is_subtest; push @{$facet_data->{amnesty}} => { tag => 'SKIP', details => $skip, } if defined $skip; push @{$facet_data->{amnesty}} => { tag => 'TODO', details => $todo, } if defined $todo; push @{$facet_data->{info}} => { details => $_, debug => 1, tag => 'PARSER', } for @errors; return $facet_data; } sub parse_tap_version { my $class = shift; my ($line) = @_; return undef unless $line =~ m/^TAP version\s/; return { about => { details => $line, }, info => [ { tag => 'INFO', debug => 0, details => $line, } ], }; } sub parse_tap_plan { my $class = shift; my ($line) = @_; return undef unless $line =~ s/^1\.\.(\d+)//; my $max = $1; my ($directive, $reason) = ("", ""); if ($max == 0) { if ($line =~ s/^\s*#\s*//) { if ($line =~ s/^(skip)\S*\s*//i) { $directive = uc($1); $reason = $line; $line = ""; } } $directive ||= "SKIP"; $reason ||= "no reason given"; } my $facet_data = { plan => { count => $max, skip => ($directive eq 'SKIP') ? 1 : 0, details => $reason, } }; push @{$facet_data->{info}} => { details => 'Extra characters after plan.', debug => 1, tag => 'PARSER', } if $line =~ m/\S/; return $facet_data; } sub parse_tap_bail { my $class = shift; my ($line) = @_; return undef unless $line =~ m/^Bail out!\s*(.*)$/; return { control => { halt => 1, details => $1, } }; } sub parse_tap_comment { my $class = shift; my ($line) = @_; return undef unless $line =~ m/^\s*#/; $line =~ s/^\s*# ?//msg; return { info => [ { details => $line, tag => 'NOTE', debug => 0, } ] }; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Collector::TapParser - Produce EventFacets from a line of TAP. =head1 DESCRIPTION This module is responsible for reading and processing any TAP output from tests. Lines of TAP output are processed into L facet data. Note that C<< Test2 -> TAP -> Test2 >> is lossy at the C<< Test2 -> TAP >> step. =head1 SYNOPSIS use Test2::Harness::Collector::TapParser qw/parse_tap_line/; my $facet_data = parse_tap_line("1..1"); is( $facet_data, { trace => {nested => 0}, hubs => [{nested => 0}], plan => { details => '', count => 1, skip => 0, }, }, "Parsed the plan" ); $facet_data = parse_tap_line("# foo"); is( $facet_data, { trace => { nested => 0 }, hubs => [ { nested => 0 } ], info => [ { tag => 'NOTE', details => 'foo', debug => 0, }, ], }, "Parsed the note" ); $facet_data = parse_tap_line("ok 1"); is( $facet_data, { trace => {nested => 0}, hubs => [{nested => 0}], assert => { no_debug => 1, pass => 1, number => '1', details => '', }, }, "Parsed the assertion" ); =head1 EXPORTS =over 4 =item $facet_data = parse_tap_line($line) Parse a line of TAP. It is assumed to be STDOUT thus all comments are turned into notes. Using this export will B add the usual C facet. It is better to use one of the other 2 exports. =item $facet_data = parse_stdout_tap($line) Parse a line of TAP from stdout. =item $facet_data = parse_stderr_tap($line) Parse a line of TAP from stderr. This will B parse comment lines (ones that start with a C<#>, which may be indented). All comments will be treated as diag's, all other lines will be ignored. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Collector/JobDir.pm0000644000175000017500000005703515012417054023112 0ustar exodistexodistpackage Test2::Harness::Collector::JobDir; use strict; use warnings; our $VERSION = '1.000158'; use File::Spec(); use Errno qw/EMFILE ENFILE/; use Carp qw/croak/; use Time::HiRes qw/time/; use List::Util qw/first/; use Test2::Util qw/ipc_separator/; use Test2::Harness::Util::UUID qw/gen_uuid/; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Harness::Util qw/maybe_read_file open_file apply_encoding/; use Test2::Harness::Event; use Test2::Harness::Util::File::Stream; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::File::Value; use Test2::Harness::Collector::TapParser qw{ parse_stdout_tap parse_stderr_tap }; use Test2::Harness::Util::HashBase qw{ {+RUN_ID}; croak "'job_id' is a required attribute" unless $self->{+JOB_ID}; croak "'job_root' is a required attribute" unless $self->{+JOB_ROOT}; $self->{+_EVENTS_SEEN} = {}; $self->{+_STDOUT_BUFFER} ||= []; $self->{+_STDERR_BUFFER} ||= []; $self->{+_EVENTS_BUFFER} ||= {}; $self->{+_READY_BUFFER} ||= []; $self->{+LAST_STAMP} = time(); } sub poll { my $self = shift; my ($max) = @_; delete $self->{+OPEN_ERRORS}; $self->_fill_buffers($max); return @{delete $self->{+OPEN_ERRORS}} if $self->{+OPEN_ERRORS}; my (@out, @new); # If we have a max number of events then we need to pass that along to the # inner-pollers, but we need to pass around how many MORE we need, this sub # will return the amount we still need. # If this finds that we do not need any more it will exit the loop instead # of returning a number. my $check = defined($max) ? sub { my $want = $max - scalar(@out) - scalar(@new); return undef if $want < 1; return $want; } : sub { 1 }; while (!defined($max) || @out < $max) { push @new => $self->_poll_streams($check->() // last); push @new => $self->_poll_timeouts($check->() // last) if $self->{+ET_BUFFER} || $self->{+PET_BUFFER}; # 'exit' MUST come last, so do not even think about grabbing # them until @new is empty. # Micro-optimization, 'exit' only ever has 1 thing, so do # not enter the subs if we do not need to. push @new => $self->_poll_exit($check->() // last) if !@new && defined $self->{+_EXIT_BUFFER}; # We need to check if the runner exited BEFORE trying to check the exit value. last unless @new; push @out => @new; @new = (); } return map { my $stamp = $_->{stamp} ? $self->{+LAST_STAMP} = $_->{stamp} : $self->{+LAST_STAMP}; Test2::Harness::Event->new(stamp => $stamp, %{$_}); } @out; } sub _poll_streams { my $self = shift; my ($max) = @_; my $ready = $self->{+_READY_BUFFER}; return splice(@$ready, 0, $max) unless @$ready < $max; my $stdout = $self->{+_STDOUT_BUFFER}; my $stdout_cg = $self->{+_STDOUT_CG} ||= []; my $stdout_params = { buffer => $stdout, comment_group => $stdout_cg, tag => 'STDOUT', debug => 0, parser => \&parse_stdout_tap, max => $max, }; my $stderr = $self->{+_STDERR_BUFFER}; my $stderr_cg = $self->{+_STDERR_CG} ||= []; my $stderr_params = { buffer => $stderr, comment_group => $stderr_cg, tag => 'STDERR', debug => 1, parser => \&parse_stderr_tap, max => $max, }; my $out_event = $self->_poll_stream($stdout_params); my $err_event = $self->_poll_stream($stderr_params); # Once both stderr and stdout are waiting for an event we should go ahead # and stick the events into ready. More often than not both streams will be # waiting for the same event, the read_buffer_event logic will avoid # duplicates. We want to call it on both buffers because some IPC # situations can result in both streams waiting for different events. Also # we need the sync point removed from both buffers so things can continue. # This is an intentional bottle-neck that keeps STDOUT, STDERR, and the # Test2 events in sync so that stderr and stdout appear where they should # (mostly) relative to the events. This is not perfect, but it is as close # as we can get when recombining 3+ output streams. if ($out_event && $err_event) { $self->_poll_streams_ready_buffer_event($stdout); $self->_poll_streams_ready_buffer_event($stderr); } if ($self->{+_EXIT_DONE} && (!$max || @$ready < $max)) { # All done, flush the comment groups $self->_poll_stream_flush_group($stdout_params) if @$stdout_cg; $self->_poll_stream_flush_group($stderr_params) if @$stderr_cg; $self->_poll_streams_flush_events(); } return splice(@$ready, 0, $max); } sub _poll_streams_flush_events { my $self = shift; my $buffers = $self->{+_EVENTS_BUFFER}; for my $pid (keys %$buffers) { for my $tid (keys %{$buffers->{$pid}}) { my $buffer = $buffers->{$pid}->{$tid} or next; while(my $e = shift @$buffer) { $e = ref($e) ? $e : decode_json($e); push @{$self->{+_READY_BUFFER}} => $self->_process_events_line($e); } } } } sub _poll_streams_ready_buffer_event { my $self = shift; my ($buffer) = @_; my $set = shift @$buffer; my ($pid, $tid, $sid) = @$set; my $seen = $self->{+_EVENTS_SEEN}; return if $seen->{$tid}->{$pid}->{$sid}; my $e = shift @{$self->{+_EVENTS_BUFFER}->{$pid}->{$tid}} or return; $seen->{$tid}->{$pid}->{$sid} = 1; $e = ref($e) ? $e : decode_json($e); die "Stream error: Events skipped or recieved out of order ($e->{stream_id} != $sid)" if $e->{stream_id} != $sid; push @{$self->{+_READY_BUFFER}} => $self->_process_events_line($e); } sub _poll_stream_add_event { my $self = shift; my ($line, $params) = @_; my $parser = $params->{parser}; my $tag = $params->{tag}; my $debug = $params->{debug}; my $facet_data = $parser->($line); $facet_data ||= {info => [{details => $line, tag => $tag, debug => $debug}]}; my $event_id = $facet_data->{about}->{uuid} ||= gen_uuid(); push @{$self->{+_READY_BUFFER}} => { facet_data => $facet_data, event_id => $event_id, job_id => $self->{+JOB_ID}, job_try => $self->{+JOB_TRY}, run_id => $self->{+RUN_ID}, }; } sub _poll_stream_flush_group { my $self = shift; my ($params) = @_; my $comment_group = $params->{comment_group}; return unless @$comment_group; shift @$comment_group; # Remove the indentation state my $line = join "\n" => @$comment_group; $self->_poll_stream_add_event($line, $params); @$comment_group = (); } sub _poll_stream_buffer_group { my $self = shift; my ($line, $params) = @_; return undef unless $line =~ m/^(\s*)#/; my $indent = $1; my $comment_group = $params->{comment_group}; if (@$comment_group && $comment_group->[0] ne $indent) { # If comment indentation has changed we do not want to append to the group $self->_poll_stream_flush_group($params); return 1; } else { # Starting a new group push @$comment_group => $indent; } push @$comment_group => $line; shift @{$params->{buffer}}; return 0; } sub _poll_stream { my $self = shift; my ($params) = @_; my $max = $params->{max}; my $buff = $params->{buffer}; my $comment_group = $params->{comment_group}; my $added = 0; while (@$buff && (!$max || $added < $max)) { my $line = $buff->[0]; # Already have an esync waiting return 1 if ref $line; chomp($line); my $esync = $self->_poll_stream_process_harness_line($line, $params); return 1 if $esync; # Put 'comment' lines together in a group, IE buffer this until we are done with comments # get undef if there was no comment to buffer # get 1 if we had to flush the buffer and start a new one # get 0 if we did buffer the event, but no flush my $stat = $self->_poll_stream_buffer_group($line, $params); if (defined($stat)) { $added += $stat; next; } # non-comment line, flush the comment group if (@$comment_group) { $self->_poll_stream_flush_group($params); $added++; next; } shift @$buff; $self->_poll_stream_add_event($line, $params); $added++; } return 0; } sub _poll_stream_process_harness_line { my $self = shift; my ($line, $params) = @_; my $job_id = $self->{+JOB_ID}; return undef unless $line =~ s/T2-HARNESS-\Q$job_id\E-(ESYNC|EVENT): (.+)//; my ($type, $data) = ($1, $2); my $esync; if ($type eq 'ESYNC') { $esync = [split ipc_separator() => $data]; } elsif ($type eq 'EVENT') { my $event_data = decode_json($data); my $pid = $event_data->{pid}; my $tid = $event_data->{tid}; my $sid = $event_data->{stream_id}; push @{$self->{+_EVENTS_BUFFER}->{$pid}->{$tid}} => $event_data; $esync = [$pid, $tid, $sid]; } else { die "Unexpected harness type: $type"; } # This becomes the esync, anything leftover actually belongs to the # next line. my $buff = $params->{buffer}; $buff->[0] = $esync; $buff->[1] = defined($buff->[1]) ? $line . $buff->[1] : $line if length $line; # Flush any comment group already buffered, an event is a sane # boundary, not above that partial comments that might be # interrupted by the sync point will be part of the next group $self->_poll_stream_flush_group($params); return $esync; } my %FILE_MAP = ( 'stdout' => [STDOUT_FILE, \&open_file], 'stderr' => [STDERR_FILE, \&open_file], 'exit' => [EXIT_FILE, 'Test2::Harness::Util::File::Value'], 'event_timeout' => [ET_FILE, 'Test2::Harness::Util::File::Value'], 'post_exit_timeout' => [PET_FILE, 'Test2::Harness::Util::File::Value'], ); sub _open_file { my $self = shift; my ($file) = @_; my $map = $FILE_MAP{$file} or croak "'$file' is not a known job file"; my ($key, $type) = @$map; return $self->{$key} if $self->{$key}; my $path = File::Spec->catfile($self->{+JOB_ROOT}, $file); my $out; if (ref $type) { return undef unless -e $path; return $self->{$key} = $self->try_open($path => sub { $type->($path, '<') }); } return $self->{$key} = $self->try_open($path => sub { $type->new(name => $path) }); } sub _fill_stream_buffers { my $self = shift; my ($max) = @_; my $stdout_state = $self->{+_STDOUT_STATE} //= {}; my $stderr_state = $self->{+_STDERR_STATE} //= {}; my $stdout_buff = $self->{+_STDOUT_BUFFER} ||= []; my $stderr_buff = $self->{+_STDERR_BUFFER} ||= []; my $stdout_file = $self->{+STDOUT_FILE} || $self->_open_file('stdout'); my $stderr_file = $self->{+STDERR_FILE} || $self->_open_file('stderr'); return unless $stdout_file && $stderr_file; my @sets = grep { defined $_->[0] } ( [$stdout_file, $stdout_buff, 'io', 'STDOUT', $stdout_state], [$stderr_file, $stderr_buff, 'io', 'STDERR', $stderr_state], ); return unless @sets; # Cache the result of the exists check on success, files can come into # existence at any time though so continue to check if it fails. while (1) { my $added = 0; my @events_files = $self->events_files(); for my $set (@events_files, @sets) { my ($file, $buff, $type, $name, $state) = @$set; next if $max && @$buff > $max; my $pos = tell($file); my $line = <$file>; if (defined($line) && ($self->{+_EXIT_DONE} || substr($line, -1) eq "\n")) { print "\n" if $state && delete $state->{$pos}; my $job_id = $self->{+JOB_ID}; if ($type eq 'io' && $line =~ s/T2-HARNESS-\Q$job_id\E-ENCODING: (.+)\n$//) { apply_encoding($file, $1); } push @$buff => $line if length($line); seek($file, 0, 1) if eof($file); # Reset EOF. $added++; } else { if ($name && defined($line) && $ENV{YATH_INTERACTIVE}) { my ($fh); if ($name eq 'STDOUT') { $fh = \*STDOUT; } elsif ($name eq 'STDERR') { $fh = \*STDERR; } my $len = length($line); if (my $check = $state->{$pos}->{len}) { if ($len != $check) { delete $state->{$pos}->{done}; $line = substr($line, $check); } else { $line = "\n[INTERACTIVE] $line"; } } else { $line = "\n[INTERACTIVE] $line"; } $state->{$pos}->{len} = $len; my $stamp = $state->{$pos}->{stamp} //= time; my $delta = time - $stamp; if($delta >= 1 && !$state->{$pos}->{done}) { $fh->autoflush(1); $state->{$pos}->{done} = 1; print $fh $line; } } seek($file, $pos, 0); } } last unless $added; } } sub events_files { my $self = shift; my $buff = $self->{+_EVENTS_BUFFER} ||= {}; my $files = $self->{+_EVENTS_FILES} ||= {}; my $dir = File::Spec->catdir($self->{+JOB_ROOT}, 'events'); return unless -d $dir; my $dh; if ($self->try_open($dir => sub { opendir($dh, $dir) or die $! })) { for my $file (readdir($dh)) { next unless '.jsonl' eq substr($file, -6); next if $files->{$file}; my $path = File::Spec->catfile($dir, $file); next if $files->{$file}; my $fh = $self->try_open( $path => sub { [ split(ipc_separator() => substr(substr($file, 6 + length(ipc_separator())), 0, -6)), open_file($path, '<'), ] } ); $files->{$file} = $fh if $fh; } } return map { [$_->[2] => $buff->{$_->[0]}->{$_->[1]} ||= [], 'jsonl'] } values %$files; } sub try_open { my $self = shift; my ($path, $callback) = @_; local ($@, $?, $!, $.); my $out; my $ok = eval { $out = $callback->(); 1; }; my $errno = $!; my $err = $@; return $out if $ok; die $@ unless $errno == ENFILE || $errno == EMFILE; my $errors = $self->{+OPEN_ERRORS} //= []; unless ($self->{+OPEN_ERROR_SEEN}->{$path}++) { push @$errors => Test2::Harness::Event->new( stamp => time, job_id => 0, job_try => undef, event_id => gen_uuid(), run_id => $self->{+RUN_ID}, facet_data => { info => [{ details => "Could not open '$path', this is NOT FATAL as yath will try again. Errno is '$errno', Exception was: $err", tag => 'INTERNAL', important => 1, }], } ); } return undef; } sub _fill_buffers { my $self = shift; my ($max) = @_; # NOTE 1: 'max' will only effect stdout, stderr, and events.jsonl, the # other files only have 1 value each so they will not eat too much memory. # # NOTE 2: 'max' only effects how many items are ADDED to the buffer, not # how many are in the buffer, that is good enough, poll() will take care of # the actual event limiting. We only use this here to make sure the buffer # grows slowly, this is important if max is used to avoid eating memory. We # still need to add to the buffers each time though in case we are waiting # for a sync event before we flush. # Wait for the directory return unless -d $self->{+JOB_ROOT}; $self->_fill_stream_buffers($max); # Do not look for exit until we are done with the other streams return if $self->{+_EXIT_DONE} || @{$self->{+_STDOUT_BUFFER}} || @{$self->{+_STDERR_BUFFER}} || first { @$_ } map { values %{$_} } values %{$self->{+_EVENTS_BUFFER}}; $self->_open_file('event_timeout'); $self->_open_file('post_exit_timeout'); my $found_timeout = 0; for my $set ([ET_FILE, ET_BUFFER], [PET_FILE, PET_BUFFER]) { my ($key, $buffer_key) = @$set; next if $self->{$buffer_key}; next unless $self->{$key} && $self->{$key}->exists; $self->{$buffer_key} = $self->{$key}->read_line // next; $found_timeout++; } return if $found_timeout; return if $self->{+OPEN_ERRORS}; my $ended = 0; # We need to check if the runner exited BEFORE trying to check the exit value. my $runner_exited = $self->{+RUNNER_PID} && !kill(0, $self->{+RUNNER_PID}); my $exit_file = $self->{+EXIT_FILE} || $self->_open_file('exit') || return; return if $self->{+OPEN_ERRORS}; if ($exit_file->exists) { my $line = $exit_file->read_line; if (defined($line)) { $self->{+_EXIT_BUFFER} = $line; $self->{+_EXIT_DONE} = 1; $ended++; } } elsif ($runner_exited) { $self->{+_EXIT_BUFFER} = '-1'; $self->{+_EXIT_DONE} = 1; $ended++; } return unless $ended; # If we found exit we need one last buffer fill on the other sources. # If we do not do this we have a race condition. Ignore the max for this. $self->_fill_stream_buffers(); } sub _poll_timeouts { my $self = shift; my @out; if (defined $self->{+ET_BUFFER} && !$self->{+ET_DONE}++) { push @out => $self->_process_timeout_line('event' => $self->{+ET_BUFFER}, <<" EOT"); Test2::Harness checks for timeouts at a configurable interval, if a test does not produce any output to stdout or stderr between intervals it will be forcefully killed under the assumption it has hung. See the '--event-timeout' option to configure the interval. EOT } if (defined $self->{+PET_BUFFER} && !$self->{+PET_DONE}++) { push @out => $self->_process_timeout_line('post-exit' => $self->{+ET_BUFFER}, <<" EOT"); Sometimes tests will fork and then return. On supported systems Test2::Harness will start all tests with their own process group and will wait for the entire group to exit before considering the test done. In these cases Test2::Harness will poll for output from the process group at a configurable interval, if no output is produced between intervals the process group will be forcefully killed. See the '--post-exit-timeout' option to configure the interval. EOT } return @out; } sub _poll_exit { my $self = shift; # Intentionally ignoring the max argument, this only ever returns 1 item, # and would not be called if max was 0. return unless defined $self->{+_EXIT_BUFFER}; my $value = delete $self->{+_EXIT_BUFFER}; return $self->_process_exit_line($value); } sub _process_events_line { my $self = shift; my ($event_data) = @_; $event_data->{job_id} = $self->{+JOB_ID}; $event_data->{job_try} = $self->{+JOB_TRY}; $event_data->{run_id} = $self->{+RUN_ID}; $event_data->{event_id} ||= $event_data->{facet_data}->{about}->{uuid} ||= gen_uuid(); return $event_data; } sub _process_exit_line { my $self = shift; my ($value) = @_; chomp($value); my $stdout = maybe_read_file(File::Spec->catfile($self->{+JOB_ROOT}, "stdout")); my $stderr = maybe_read_file(File::Spec->catfile($self->{+JOB_ROOT}, "stderr")); $stdout =~ s/T2-HARNESS-\S+-(?:ESYNC|EVENT): .+\n//g; $stderr =~ s/T2-HARNESS-\S+-(?:ESYNC|EVENT): .+\n//g; my $event_id = gen_uuid(); my ($exit, $err, $sig, $dmp, $stamp, $retry) = (split(/\s+/, $value), '', '', '', '', '', ''); $self->{+DONE} = {retry => $retry}; return { event_id => $event_id, job_id => $self->{+JOB_ID}, job_try => $self->{+JOB_TRY}, run_id => $self->{+RUN_ID}, stamp => $stamp, facet_data => { about => {uuid => $event_id}, harness_job_exit => { details => "Test script exited $exit ($err\:$sig)", exit => $exit, code => $err, signal => $sig, dumped => $dmp, retry => $retry, job_id => $self->{+JOB_ID}, job_try => $self->{+JOB_TRY}, stdout => $stdout, stderr => $stderr, stamp => $stamp, line => $value, }, } }; } sub _process_timeout_line { my $self = shift; my ($type, $buffer, $reason) = @_; chomp($buffer //= ''); my ($stamp, $delta) = split /\s+/, $buffer; $stamp //= time(); $delta = defined($delta) ? sprintf('%.4f', $delta) : '??'; my $event_id = gen_uuid(); return { event_id => $event_id, job_id => $self->{+JOB_ID}, job_try => $self->{+JOB_TRY}, run_id => $self->{+RUN_ID}, stamp => $stamp, facet_data => { about => {uuid => $event_id, details => "Timeout ($type)"}, errors => [ { tag => 'TIMEOUT', details => "A timeout ($type) has occured (after $delta seconds), job was forcefully killed", fail => 1, }, ], info => [ { tag => 'TIMEOUT', debug => 1, important => 1, details => $reason, }, ], } }; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Collector::JobDir - Job Directory Parser, read events from an active jobs output directory. =head1 DESCRIPTION This module is responsible for reading and parsing a running jobs output directory. The result is an event stream. This module is not intended for external use, it is an implementation detail and can change at any time. Currently instances of this module are not passed to any plugins or callbacks. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Auditor/0000755000175000017500000000000015012417054021052 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Auditor/TimeTracker.pm0000644000175000017500000002101115012417054023615 0ustar exodistexodistpackage Test2::Harness::Auditor::TimeTracker; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Harness::Util qw/hub_truth/; use Test2::Util::Times qw/render_duration/; use Test2::Harness::Util::HashBase qw{ -start -start_id -stop -stop_id -first -first_id -last -last_id -complete_id -_source -_totals }; sub process { my $self = shift; my ($event, $f, $assertion_count) = @_; # Invalidate cache delete $self->{+_TOTALS}; delete $self->{+_SOURCE}; my $stamp = $event->{stamp} or return; my $id = $event->{event_id} // 'N/A'; $f //= $event->{facet_data}; if ($f->{harness_job_exit}) { $self->{+STOP} = $stamp; $self->{+STOP_ID} = $id; } return if $self->{+COMPLETE_ID}; if ($f->{harness_job_start}) { $self->{+START} = $stamp; $self->{+START_ID} = $id; } # These events absolutely end the events phase, and do not count as part of # it. $self->{+COMPLETE_ID} //= $event->{event_id} if $f->{harness_job_exit}; $self->{+COMPLETE_ID} //= $event->{event_id} if $f->{control} && $f->{control}->{phase} && $f->{control}->{phase} eq 'END'; return if $self->{+COMPLETE_ID}; # Plan still counts as 'event' phase, so do not return if we are setting this now $self->{+COMPLETE_ID} //= $event->{event_id} if $assertion_count && $f->{plan} && !$f->{plan}->{none}; return unless $f->{trace}; # Events with traces are "event" phase. # Always replace the last, if we got this far. $self->{+LAST} = $stamp; $self->{+LAST_ID} = $id; # Only set the first one once return if $self->{+FIRST}; $self->{+FIRST} = $stamp; $self->{+FIRST_ID} = $id; return; } sub useful { my $self = shift; my @got = grep { defined $self->{$_} } START, FIRST, LAST, STOP; return @got > 1; } my @TOTAL_FIELDS = qw/startup events cleanup total/; my %TOTAL_SOURCES = ( startup => [FIRST, START], events => [LAST, FIRST], cleanup => [STOP, LAST], total => [STOP, START] ); my %TOTAL_DESC = ( startup => "Time from launch to first test event.", events => "Time spent generating test events.", cleanup => "Time from last test event to test exit.", total => "Total time", ); sub totals { my $self = shift; return $self->{+_TOTALS} if $self->{+_TOTALS}; my $out = {}; for my $field (@TOTAL_FIELDS) { my $sources = $TOTAL_SOURCES{$field} or die "Invalid field: $field"; my @vals = @{$self}{@$sources}; next unless defined($vals[0]) && defined($vals[1]); my $delta = $vals[0] - $vals[1]; $out->{$field} = $delta; $out->{"h_$field"} = render_duration($delta); } return $self->{+_TOTALS} = $out; } sub source { my $self = shift; return $self->{+_SOURCE} if $self->{+_SOURCE}; my @fields = ( START, START_ID, STOP, STOP_ID, FIRST, FIRST_ID, LAST, LAST_ID, COMPLETE_ID, ); my %out; @out{@fields} = @{$self}{@fields}; return $self->{+_SOURCE} = \%out; } sub data_dump { my $self = shift; return { totals => $self->totals, source => $self->source, }; } sub summary { my $self = shift; my $totals = $self->totals; my $summary = ""; for my $field (@TOTAL_FIELDS) { my $hval = $totals->{"h_$field"} // next; my $title = ucfirst($field); $summary .= " | " if $summary; $summary .= "$title: $hval"; } return $summary; } sub table { my $self = shift; my $totals = $self->totals; my $table = { header => ["Phase", "Time", "Raw", "Explanation"], rows => [], }; for my $field (@TOTAL_FIELDS) { my $val = $totals->{$field} // next; my $hval = $totals->{"h_$field"}; my $title = ucfirst($field); push @{$table->{rows}} => [$title, $hval, $val, $TOTAL_DESC{$field}]; } return $table; } sub job_fields { my $self = shift; my $totals = $self->totals; my @out; for my $field (@TOTAL_FIELDS) { my $val = $totals->{$field} // next; my $hval = $totals->{"h_$field"}; my $data = {}; my $sources = $TOTAL_SOURCES{$field}; for my $source (@$sources) { $data->{$source} = { stamp => $self->{$source}, event_id => $self->{"${source}_id"}, }; } push @out => {name => "time_$field", details => $hval, raw => $val, data => $data}; } return @out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Auditor::TimeTracker - Module that tracks timing data while an event stream is processed. =head1 DESCRIPTION The timetracker module tracks timing data of an event stream. All events for a given job should be run through a timetracker, which can then give data on how long the test took in each of several stages. =over 4 =item startup - Time from launch to first test event. =item events - Time spent generating test events. =item cleanup - Time from last test event to test exit. =item total - Total time. =back =head1 SYNOPSIS use Test2::Harness::Auditor::TimeTracker; my $tracker = Test2::Harness::Auditor::TimeTracker->new(); my $assert_count = 0; for my $event (@events) { my $facet_data = $events->facet_data; $assert_count++ if $facet_data->{assert}; $tracker->process($event, $facet_data, $assert_count); } print $tracker->summary; # Startup: 0.00708s | Events: 0.00000s | Cleanup: 0.10390s | Total: 0.11098s =head1 METHODS =over 4 =item $tracker->process($event, $facet_data, $assert_count) =item $tracker->process($event, undef, $assert_count) TimeTracker builds its state from multiple events, each event should be processed by this method. The second argument is optional, if no facet_data is provided it will pull the facet_data from the event itself. This is mainly a micro-optimization to avoid calling the C method on the event multiple times if you have already called it. =item $bool = $tracker->useful() Returns true if there is any useful data to display. =item $totals = $tracker->totals() Returns the totals like this: { # Raw numbers startup => ..., events => ..., cleanup => ..., total => ..., # Human friendly versions h_startup => ..., h_events => ..., h_cleanup => ..., h_total => ..., } =item $source = $tracker->source() This method returns the data from which the totals are derived. { start => ..., # timestamp of the job starting stop => ..., # timestamp of the job ending first => ..., # timestamp of the first non-harness event last => ..., # timestamp of the last non-harness event # These are event_id's of the events that provided the above stamps. start_id => ..., stop_id => ..., first_id => ..., last_id => ..., complete_id => ..., } =item $data = $tracker->data_dump This dumps the totals and source data: { totals => $tracker->totals, source => $tracker->source, } =item $string = $tracker->summary This produces a summary string of the totals data: Startup: 0.00708s | Events: 0.00000s | Cleanup: 0.10390s | Total: 0.11098s Fields that have no data will be ommited from the string. =item $table = $tracker->table Returns this structure that is good for use in L. { header => ["Phase", "Time", "Raw", "Explanation"], rows => [ ['startup', $human_readible, $raw, "Time from launch to first test event."], ['events', $human_radible, $raw, 'Time spent generating test events.'], ['cleanup', $human_radible, $raw, 'Time from last test event to test exit.'], ['total', $human_radible, $raw, 'Total time.'], ], } =item @items = $tracker->job_fields() This is used to obtain extra data to attach to the job completion event. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Auditor/Watcher.pm0000644000175000017500000003356315012417054023017 0ustar exodistexodistpackage Test2::Harness::Auditor::Watcher; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak confess/; use Scalar::Util qw/blessed/; use List::Util qw/first max/; use Test2::Harness::Util::UUID qw/gen_uuid/; use Test2::Harness::Util qw/hub_truth parse_exit/; use Test2::Harness::Auditor::TimeTracker; use Test2::Harness::Util::HashBase qw{ -job -try -assertion_count -exit -plan -_errors -_failures -_sub_failures -_plans -_info -_sub_info -_subtest_id -nested -subtests -numbers -times -halt -failed_subtest_tree }; sub init { my $self = shift; croak "'job' is a required attribute" unless $self->{+JOB}; croak "'try' is a required attribute" unless defined $self->{+TRY}; $self->{+_FAILURES} = 0; $self->{+_ERRORS} = 0; $self->{+ASSERTION_COUNT} = 0; $self->{+NUMBERS} = {}; $self->{+TIMES} = Test2::Harness::Auditor::TimeTracker->new(); $self->{+NESTED} = 0 unless defined $self->{+NESTED}; } sub pass { !$_[0]->fail } sub file { $_[0]->{+JOB}->{file} } sub fail { !!$_[0]->fail_error_facet_list } sub has_exit { defined $_[0]->{+EXIT} } sub has_plan { defined $_[0]->{+PLAN} } sub process { my $self = shift; my ($event) = @_; my $f = $event->{facet_data}; my $hf = hub_truth($f); my $nested = $hf->{nested} || 0; $self->times->process($event, $f, $self->{+ASSERTION_COUNT}) unless $nested; return if $hf->{buffered}; my $is_ours = $nested == $self->{+NESTED}; return unless $is_ours || $f->{from_tap}; # Add parent if we start a buffered subtest if ($f->{harness} && $f->{harness}->{subtest_start}) { my $st = $self->{+SUBTESTS}->{$nested + 1} ||= {}; $st->{event} = $event; $f->{harness_watcher}->{no_render} = 1; return; } my @out; # Not actually a subtest end, someone printed to STDOUT if ($f->{from_tap} && $f->{harness}->{subtest_end} && !($self->{+SUBTESTS} && keys %{$self->{+SUBTESTS}})) { # Alter $f so that this incorrect event is not sent to the renderer. $f->{harness_watcher}->{no_render} = 1; # Make a new $f and $event for the rest of the processing. $f = { %{$f}, harness_watcher => {added_by_watcher => 1}, parent => undef, trace => undef, harness => { %{$f->{harness} || {}}, subtest_end => undef, }, info => [ @{$f->{info} || []}, { details => $f->{from_tap}->{details}, tag => $f->{from_tap}->{source} || 'STDOUT', from_harness => 1, } ], }; $event = Test2::Harness::Event->new(stamp => time, job_try => $self->{+TRY}, facet_data => $f); } push @out => $event; # Close any deeper subtests if (my $sts = $self->{+SUBTESTS}) { my @close = sort { $b <=> $a } grep { $_ > $nested } keys %$sts; for my $n (@close) { my $st = delete $sts->{$n}; my $se = $st->{event} || $event; my $fd = $se->{facet_data}; delete $fd->{harness_watcher}->{no_render}; $fd->{parent}->{hid} ||= $n; $fd->{parent}->{children} ||= $st->{children}; $fd->{harness}->{closed_by} = $event; $fd->{harness}->{closed_by_eid} = $event->{event_id}; my $pn = $n - 1; if ($st->{event}) { if ($pn > $self->{+NESTED}) { push @{$sts->{$pn}->{children}} => $fd; } elsif ($pn == $self->{+NESTED}) { $self->subtest_process($fd, $se); push @out => $se; } } else { push @out => $se if $self->{+NESTED} && $pn == $self->{+NESTED}; } } } unless ($is_ours) { my $st = $self->{+SUBTESTS}->{$nested} ||= {}; my $fd = {%$f}; push @{$st->{children}} => $fd; return @out; } $self->subtest_process($f, $event); return @out; } sub subtest_process { my $self = shift; my ($f, $event) = @_; my $closer = delete $f->{harness}->{closed_by}; $event ||= Test2::Harness::Event->new(facet_data => $f, job_try => $self->{+TRY}); $self->{+NUMBERS}->{$f->{assert}->{number}}++ if $f->{assert} && $f->{assert}->{number}; if ($f->{parent} && $f->{assert}) { my $name = $f->{assert}->{details} // "unnamed subtest ($f->{trace}->{frame}->[1] line $f->{trace}->{frame}->[2])"; my $subwatcher = blessed($self)->new(nested => $self->{+NESTED} + 1, job => $self->{+JOB}, try => $self->{+TRY}); my $id = 1; for my $sf (@{$f->{parent}->{children}}) { $sf->{harness}->{job_id} ||= $f->{harness}->{job_id}; $sf->{harness}->{run_id} ||= $f->{harness}->{run_id}; $sf->{harness}->{event_id} ||= $sf->{about}->{uuid} ||= gen_uuid(); $subwatcher->subtest_process($sf); } my @errors = $subwatcher->subtest_fail_error_facet_list(); if ($f->{harness}->{subtest_start}) { push @{$f->{errors}} => {tag => 'REASON', fail => 1, from_harness => 1, details => "Buffered subtest ended abruptly (missing closing brace event)"} unless $closer && $closer->{facet_data}->{harness}->{subtest_end}; } my $fail = 0; if (@errors) { push @{$f->{errors}} => @errors; $fail = 1; } else { $fail ||= $f->{assert} && !$f->{assert}->{pass} && !($f->{amnesty} && @{$f->{amnesty}}); $fail ||= $f->{control} && ($f->{control}->{halt} || $f->{control}->{terminate}); $fail ||= $f->{errors} && first { $_->{fail} } @{$f->{errors}}; } if ($fail) { $self->{+_SUB_FAILURES}++; # Populate the tree up to this subtest my $tree = $self->{+FAILED_SUBTEST_TREE} //= []; push @$tree => [$name, $subwatcher->{+FAILED_SUBTEST_TREE} // []]; } } $self->{+ASSERTION_COUNT}++ if $f->{assert}; if ($f->{assert} && !$f->{assert}->{pass} && !($f->{amnesty} && @{$f->{amnesty}})) { $self->{+_FAILURES}++; } if ($f->{control} || $f->{errors}) { my $err ||= $f->{control} && ($f->{control}->{halt} || $f->{control}->{terminate}); $err ||= $f->{errors} && first { $_->{fail} } @{$f->{errors}}; $self->{+_ERRORS}++ if $err; $self->{+HALT} = $f->{control}->{details} || '1' if $f->{control} && $f->{control}->{halt} && (!$self->{+HALT} || $self->{+HALT} eq '1'); } if ($f->{plan} && !$f->{plan}->{none}) { $self->{+_PLANS}++; $self->{+PLAN} = $f->{plan}; } if ($f->{harness_job_exit}) { $self->{+EXIT} = $f->{harness_job_exit}->{exit}; my $file = $self->file(); my $end = $f->{harness_job_end} = { file => $file, rel_file => File::Spec->abs2rel($file), abs_file => File::Spec->rel2abs($file), retry => $f->{harness_job_exit}->{retry}, fail => $self->fail(), stamp => $f->{harness_job_exit}->{stamp}, }; my $plan = $self->plan; $end->{skip} = $plan->{details} || "No reason given" if $plan && !$plan->{count}; my $times = $self->times; if ($times && $times->useful) { $end->{times} = $times->data_dump; push @{$f->{harness_job_fields}} => $times->job_fields; push @{$f->{info}} => {tag => 'TIME', details => $times->summary, table => $times->table}; } push @{$f->{errors}} => $self->fail_error_facet_list; } return; } sub subtest_fail_error_facet_list { my $self = shift; return @{$self->{+_SUB_INFO}} if $self->{+_SUB_INFO}; my @out; my $plan = $self->{+PLAN} ? $self->{+PLAN}->{count} : undef; my $count = $self->{+ASSERTION_COUNT}; my $numbers = $self->{+NUMBERS}; my $max = max(keys %$numbers); if ($max) { for my $i (1 .. $max) { if (!$numbers->{$i}) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Assertion number $i was never seen"}; } elsif ($numbers->{$i} > 1) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Assertion number $i was seen more than once"}; } } } if (!$self->{+_PLANS}) { if ($count) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "No plan was declared"}; } else { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "No plan was declared, and no assertions were made."}; } } elsif ($self->{+_PLANS} > 1) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Too many plans were declared (Count: $self->{+_PLANS})"}; } push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Planned for $plan assertions, but saw $self->{+ASSERTION_COUNT}"} if $plan && $count != $plan; push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Subtest failures were encountered (Count: $self->{+_SUB_FAILURES})"} if $self->{+_SUB_FAILURES}; return @out; } sub fail_error_facet_list { my $self = shift; return @{$self->{+_INFO}} if $self->{+_INFO}; my @out; my $incomplete_subtests = values %{$self->{+SUBTESTS}}; push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "One or more incomplete subtests (Count: $incomplete_subtests)"} if $incomplete_subtests; if (my $wstat = $self->{+EXIT}) { if ($wstat == -1) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "The harness could not get the exit code! (Code: $wstat)"}; } else { my $e = parse_exit($wstat); if ($e->{err}) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Test script returned error (Err: $e->{err})"}; } if ($e->{sig}) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Test script returned error (Signal: $e->{sig})"}; } } } push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Errors were encountered (Count: $self->{+_ERRORS})"} if $self->{+_ERRORS}; push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Assertion failures were encountered (Count: $self->{+_FAILURES})"} if $self->{+_FAILURES}; push @out => $self->subtest_fail_error_facet_list(); return @out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Auditor::Watcher - Class to monitor events for a single job and pass judgement on the result. =head1 DESCRIPTION This module represents a per-job state tracker. This module sees every event and manages the state produced. In the end this tracker determines if a test job passed or failed, and why. =head1 SYNOPSIS use Test2::Harness::Auditor::Watcher; my $watcher = Test2::Harness::Auditor::Watcher->new(); for my $event (@events) { $watcher->process($event); } print "Pass!" if $watcher->pass; print "Fail!" if $watcher->fail; =head1 METHODS =over 4 =item $int = $watcher->assertion_count() Number of assertions that have been seen. =item $exit = $watcher->exit() If the job has exited this will return the exit value (integer, 0 or greater). If the job has not exited yet (or at least if the watcher has not seen the exit event yet) this will return undef. =item $bool = $watcher->fail() Returns true if the job has failed/is failing. =item @error_facets = $watcher->fail_error_facet_list Used internally to get a list of 'error' facets to inject into the harness_job_exit event. =item $file = $watcher->file If the test file is known this will return it (string). This will return undef if the file is not yet known. =item $string = $watcher->halt If the test was halted (bail-out) this will contain the human readible reason. =item $bool = $watcher->has_exit Check if the exit value is known. =item $bool = $watcher->has_plan Check if a plan has been seen. =item $job = $watcher->job If the job is known this will return the detailed structure of the job. =item $int = $watcher->nested If this watcher represents a subtest this will be an integer greater than 0, the top-level test is 0. =item $hash = $watcher->numbers This is an internal state tracking what test numbers have been seen. This is really only applicable in tests that produced TAP. =item $bool = $watcher->pass Check if the test job is passing. =item $plan_facet = $watcher->plan() If the plan facet has been seen this will return it. =item $watcher->process($event); Modify the state based on the provided event. =item $watcher->subtest_fail_error_facet_list Used internally to get a list of 'error' facets to inject into the harness_job_exit event. =item $times = $watcher->times() Retuns the L instance. =item $int = $watcher->try() Sometimes a job is run more than once, in those cases this will be an integer greater than 0 representing the try. 0 is used for the first try. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Settings/0000755000175000017500000000000015012417054021243 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Settings/Prefix.pm0000644000175000017500000001000215012417054023027 0ustar exodistexodistpackage Test2::Harness::Settings::Prefix; use strict; use warnings; our $VERSION = '1.000158'; use Carp(); use Test2::Harness::Util(); sub new { my $class = shift; my $hash = {@_}; return bless \$hash, $class; } sub vivify_field { my $self = shift; my ($field) = @_; return \(${$self}->{$field}); } sub check_field { my $self = shift; my ($field) = @_; return exists ${$self}->{$field}; } sub field : lvalue { my $self = shift; my ($field, @args) = @_; Carp::croak("Too many arguments for field()") if @args > 1; Carp::croak("The '$field' field does not exist") unless exists ${$self}->{$field}; (${$self}->{$field}) = @args if @args; return ${$self}->{$field}; } sub remove_field { my $self = shift; my ($field) = @_; delete ${$self}->{$field}; } our $AUTOLOAD; sub AUTOLOAD : lvalue { my $this = shift; my $field = $AUTOLOAD; $field =~ s/^.*:://g; return if $field eq 'DESTROY'; Carp::croak("Method $field() must be called on a blessed instance") unless ref($this); Carp::croak("Too many arguments for $field()") if @_ > 1; $this->field($field, @_); } sub TO_JSON { my $self = shift; return {%$$self}; } sub build { my $self = shift; my ($class, @args) = @_; require(Test2::Harness::Util::mod2file($class)); return $class->new(%$$self, @args); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Settings::Prefix - Abstraction of a settings category, aka prefix. =head1 DESCRIPTION This class represents a settings category (prefix). =head1 SYNOPSIS # You will rarely if ever need to construct settings yourself, usually a # component of Test2::Harness will expose them to you. my $settings = $thing->settings; my $display = $settings->display; # Once you have your prefix you can read data from it: my $verbose = $display->verbose; # If you dislike autoload methods you can use the 'field' method: my $verbose = $display->field('verbose'); # You can also change values: $display->field(verbose => 1); # You can also use the autoloaded method as an lvalue, but this breaks on # perls older than 5.16, so it is not used internally, and you should only # use it if you know you will never need an older perl: $display->verbose = 1; =head1 METHODS Note that any field that does not conflict with the predefined methods can be accessed via AUTOLOAD generating the methods as needed. =over 4 =item $scalar_ref = $prefix->vivify_field($field_name) This will force a field into existance. It returns a scalar reference to the field which can be used to set the value: my $vref = $display->vivify_field('verbose'); # Create or find field ${$vref} = 1; # set verbosity to 1 =item $bool = $prefix->check_field($field_name) Check if a field is defined or not. =item $val = $prefix->field($field_name) =item $val = $prefix->$field_name =item $prefix->field($field_name, $val) =item $prefix->$field_name = $val Retrieve or set the value of the specified field. This will throw an exception if the field does not exist. B: The lvalue form C<< $prefix->$field_name = $val >> breaks on perls older then 5.16. =item $thing = $prefix->build($class, @args) This will create an instance of C<$class> passing the key/value pairs from the prefix as arguments. Additional arguments can be provided in C<@args>. =item $hashref = $prefix->TO_JSON() This method allows settings to be serialized into JSON. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/IPC/0000755000175000017500000000000015012417054020056 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/IPC/Process.pm0000644000175000017500000000441315012417054022034 0ustar exodistexodistpackage Test2::Harness::IPC::Process; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use Test2::Harness::Util::HashBase qw{ {+CATEGORY} //= 'default' } sub set_pid { my $self = shift; my ($pid) = @_; croak "pid has already been set" if defined $self->{+PID}; $self->{+PID} = $pid; } sub set_exit { my $self = shift; my ($ipc, $exit, $time) = @_; croak "exit has already been set" if defined $self->{+EXIT}; $self->{+EXIT} = $exit; $self->{+EXIT_TIME} = $time; } sub spawn_params { my $self = shift; my $class = ref($self) || $self; croak "Process class '$class' does not implement 'spawn_params()'"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::IPC::Process - Base class for processes controlled by Test2::Harness::IPC. =head1 DESCRIPTION All processes controlled by L should subclass this one. =head1 ATTRIBUTES =over 4 =item $int = $proc->exit Exit value, if set. Otherwise C. =item $stamp = $proc->exit_time Timestamp of the process exit, if set, otherwise C. =item $pid = $proc->pid Pid of the process, if it has been started. =item $cat = $proc->category Set at construction, C<'default'> if not provided. =back =head1 METHODS =over 4 =item $opt->set_pid($pid) Set the process id. =item $opt->set_exit($ipc, $exit, $time) Set the process as complete. $exit should be the exit value. $time should be a timestamp. $ipc is an instance of L. =item $hashref = $opt->spawn_params() Used when spawning the process, args go to C from L. The base class throws an exception if this method is called. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/0000755000175000017500000000000015012417054020714 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Runner/Resource/0000755000175000017500000000000015012417054022503 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Runner/Resource/SharedJobSlots/0000755000175000017500000000000015012417054025371 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Runner/Resource/SharedJobSlots/Config.pm0000644000175000017500000001242315012417054027136 0ustar exodistexodistpackage Test2::Harness::Runner::Resource::SharedJobSlots::Config; use strict; use warnings; our $VERSION = '1.000158'; use YAML::Tiny; use Sys::Hostname qw/hostname/; use App::Yath::Util qw/find_in_updir/; use Test2::Harness::Util::HashBase qw{ check_prefix('runner')) ? $settings->runner->shared_jobs_config : '.sharedjobslots.yml'; $config_file = ($base_name =~ m{(/|\\)} || -e $base_name) ? $base_name : find_in_updir($base_name); } return unless $config_file && -e $config_file; return $class->new(%opts, config_file => $config_file); } sub init { my $self = shift; my $config_file = $self->{+CONFIG_FILE}; my $config = YAML::Tiny->read($config_file) or die "Could not read '$config_file'"; $config = $self->{+CONFIG_RAW} = $config->[0]; # First doc only my $host = $self->{+HOST} //= hostname(); # Normalize an empty host config section to a hashref $config->{$host} ||= {} if exists $config->{$host}; unless ($self->{+HOST_CONF} = $config->{$host}) { if ($self->{+HOST_CONF} = $config->{DEFAULT}) { $self->{+HOST} = 'DEFAULT'; } else { die "Could not find '$host' or 'DEFAULT' settings in '$config_file'.\n"; } warn <<" EOT" unless $self->{+HOST_CONF}->{no_warning}; Using the 'DEFAULT' shared-slots host config. You may want to add the current host to the config file. To silence this warning, set the 'no_warning' key to true in the DEFAULT host config. Config File: $config_file Current Host: $host EOT } if ($self->{+HOST_CONF}->{use_common} //= 1) { $self->{+COMMON_CONF} = $config->{'COMMON'} // {}; } $self->{+COMMON_CONF} //= {}; #sanity check $self->max_slots; return; } sub state_umask { $_[0]->{+STATE_UMASK} //= $_[0]->_get_config_option(+STATE_UMASK, default => 0007) } sub state_file { $_[0]->{+STATE_FILE} //= $_[0]->_get_config_option(+STATE_FILE, require => 1) } sub max_slots { $_[0]->{+MAX_SLOTS} //= $_[0]->_get_config_option(+MAX_SLOTS, required => 1) } sub min_slots_per_run { $_[0]->{+MIN_SLOTS_PER_RUN} //= $_[0]->_get_config_option(+MIN_SLOTS_PER_RUN, default => 0) } sub max_slots_per_job { $_[0]->{+MAX_SLOTS_PER_JOB} //= $_[0]->_get_config_option(+MAX_SLOTS_PER_JOB, default => $_[0]->max_slots) } sub max_slots_per_run { $_[0]->{+MAX_SLOTS_PER_RUN} //= $_[0]->_get_config_option(+MAX_SLOTS_PER_RUN, default => $_[0]->max_slots) } sub default_slots_per_job { $_[0]->{+DEFAULT_SLOTS_PER_JOB} //= $_[0]->_get_config_option(+DEFAULT_SLOTS_PER_JOB, default => $_[0]->max_slots_per_job) } sub default_slots_per_run { $_[0]->{+DEFAULT_SLOTS_PER_RUN} //= $_[0]->_get_config_option(+DEFAULT_SLOTS_PER_RUN, default => $_[0]->max_slots_per_run) } sub disabled { $_[0]->{+DISABLED} //= $_[0]->_get_config_option(+DISABLED, default => 0) } sub _get_config_option { my $self = shift; my ($field, %opts) = @_; my $val = $self->{+HOST_CONF}->{$field} // $self->{+COMMON_CONF}->{$field} // $opts{default}; die "'$field' not set in '$self->{+CONFIG_FILE}' for host '$self->{+HOST}' or under 'COMMON' config.\n" if $opts{required} && !defined($val); return $val; } sub algorithm { my $self = shift; return $self->{+ALGORITHM} if $self->{+ALGORITHM}; my $algorithm = $self->_get_config_option(+ALGORITHM, default => 'fair'); if ($algorithm =~ m/^(.*)::([^:]+)$/) { my ($mod, $sub) = ($1, $2); require(mod2file($mod)); } else { require Test2::Harness::Runner::Resource::SharedJobSlots::State; my $short = $algorithm; $algorithm = "_redistribute_$algorithm"; die "'$short' is not a valid algorithm (in file '$self->{+CONFIG_FILE}' under host '$self->{+HOST}' key 'algorithm'). Must be 'fair', 'first', or a Fully::Qualified::Module::function_name." unless Test2::Harness::Runner::Resource::SharedJobSlots::State->can($algorithm); } return $self->{+ALGORITHM} = $algorithm; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Resource::SharedJobSlots::Config - Config for shared job slots =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2022 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/Resource/SharedJobSlots/State.pm0000644000175000017500000003506715012417054027022 0ustar exodistexodistpackage Test2::Harness::Runner::Resource::SharedJobSlots::State; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Harness::Util::File::JSON; use Scalar::Util qw/weaken/; use Time::HiRes qw/time/; use List::Util qw/first min sum0 max/; use Carp qw/croak confess carp/; use Fcntl qw/:flock SEEK_END/; use Errno qw/EINTR EAGAIN ESRCH/; use Test2::Harness::Util::HashBase qw{ {+STATE_FILE}; croak "'max_slots' is a required attribute" unless $self->{+MAX_SLOTS}; croak "'max_slots_per_job' is a required attribute" unless $self->{+MAX_SLOTS_PER_JOB}; croak "'max_slots_per_run' is a required attribute" unless $self->{+MAX_SLOTS_PER_RUN}; $self->{+MY_MAX_SLOTS} //= $self->{+MAX_SLOTS}; $self->{+MY_MAX_SLOTS_PER_JOB} //= $self->{+MAX_SLOTS_PER_JOB}; $self->{+MIN_SLOTS_PER_RUN} //= 0; $self->{+STATE_UMASK} //= 0007; $self->{+NAME} //= $self->{+RUNNER_ID}; $self->{+ALGORITHM} //= '_redistribute_fair'; } sub init_state { my $self = shift; return { RUNNERS() => {} }; } sub state { shift->transaction('r') } sub transaction { my $self = shift; my ($mode, $cb, @args) = @_; $mode //= 'r'; my $write = $mode eq 'w' || $mode eq 'rw'; my $read = $mode eq 'ro' || $mode eq 'r'; croak "mode must be 'w', 'rw', 'r', or 'ro', got '$mode'" unless $write || $read; confess "Write mode requires a 'runner_id'" if $write && !$self->{+RUNNER_ID}; confess "Write mode requires a 'runner_pid'" if $write && !$self->{+RUNNER_PID}; my ($lock, $state, $local); if ($state = $self->{+TRANSACTION}) { $local = $state->{+LOCAL}; confess "Attempted a 'write' transaction inside of a read-only transaction" if $write && !$local->{write}; } else { my $oldmask = umask($self->{+STATE_UMASK}); my $ok = eval { my $lockf = "$self->{+STATE_FILE}.LOCK"; open($lock, '>>', $lockf) or die "Could not open lock file '$lockf': $!"; while (1) { last if flock($lock, $write ? LOCK_EX : LOCK_SH); next if $! == EINTR || $! == EAGAIN; warn "Could not get lock: $!"; } $state = $self->_read_state(); $local = $state->{+LOCAL} = { lock => $lock, mode => $mode, write => $write, stack => [{cb => $cb, args => \@args}], }; weaken($state->{+LOCAL}->{lock}); 1; }; my $err = $@; umask($oldmask); die $err unless $ok; } local @{$local}{qw/write mode stack/} = ($write, $mode, [@{$local->{stack}}, {cb => $cb, args => \@args}]) if $self->{+TRANSACTION}; local $self->{+TRANSACTION} = $state; if ($write) { if ($self->{+REGISTERED}) { $self->_verify_registration($state); } else { $self->_update_registration($state); } } $self->_clear_old_registrations($state); my $out; my $ok = eval { $out = $cb ? $self->$cb($state, @args) : $state; 1 }; my $err = $@; if ($ok && $write) { $self->_clear_old_registrations($state); $self->_update_registration($state) unless $self->{+UNREGISTERED}; $self->_write_state($state); } if ($lock) { flock($lock, LOCK_UN) or die "Could not release lock: $!"; } die $err unless $ok; return $out; } sub _read_state { my $self = shift; return $self->init_state unless -e $self->{+STATE_FILE}; my $file = Test2::Harness::Util::File::JSON->new(name => $self->{+STATE_FILE}); my ($ok, $err); for (1 .. 5) { my $state; $ok = eval { $state = $file->maybe_read(); 1}; $err = $@; return $state ||= $self->init_state if $ok; sleep 0.2; } warn "Corrupted state? Resetting state to initial. Error that caused this was:\n======\n$err\n======\n"; return $self->init_state; } sub _write_state { my $self = shift; my ($state) = @_; my $state_copy = {%$state}; my $local = delete $state_copy->{+LOCAL}; confess "Attempted write with no lock" unless $local->{lock}; confess "Attempted write with a read-only lock" unless $local->{write}; my $oldmask = umask($self->{+STATE_UMASK}); my $ok = eval { my $file = Test2::Harness::Util::File::JSON->new(name => $self->{+STATE_FILE}); $file->rewrite($state_copy); 1; }; my $err = $@; umask($oldmask); die $err unless $ok; } sub update_registration { $_[0]->transaction(rw => '_update_registration') } sub remove_registration { $_[0]->transaction(rw => '_update_registration', remove => 1) } sub _update_registration { my $self = shift; my ($state, %params) = @_; my $runner_id = $self->{+RUNNER_ID}; my $runner_pid = $self->{+RUNNER_PID}; my $entry = $state->{runners}->{$runner_id} //= $state->{runners}->{$runner_id} = { runner_id => $runner_id, runner_pid => $runner_pid, name => $self->{+NAME}, dir => $self->{+DIR}, user => $ENV{USER}, added => time, todo => 0, allocated => 0, allotment => 0, assigned => {}, max_slots => $self->{+MY_MAX_SLOTS}, max_slots_per_job => $self->{+MY_MAX_SLOTS_PER_JOB}, }; # Update our last checking time $entry->{seen} = time; $self->{+REGISTERED} = 1; return $state unless $params{remove}; $self->{+UNREGISTERED} = 1; $entry->{remove} = 1; return $state; } sub _verify_registration { my $self = shift; my ($state) = @_; return unless $self->{+REGISTERED}; my $runner_id = $self->{+RUNNER_ID}; my $entry = $state->{+RUNNERS}->{$runner_id}; # Do not allow for a new expiration. If the state has already expired us we will see it. $entry->{seen} = time if $entry; return unless $self->{+UNREGISTERED} //= $self->_entry_expired($entry); confess "Shared slot registration expired"; } sub _entry_expired { my $self = shift; my ($entry) = @_; return 1 unless $entry; return 1 if $entry->{remove}; if (my $pid = $entry->{runner_pid}) { my $ret = kill(0, $pid); my $err = $!; return 1 if $ret == 0 && $! == ESRCH; } my $seen = $entry->{seen} or return 1; my $delta = time - $seen; return 1 if $delta > TIMEOUT(); return 0; } sub _clear_old_registrations { my $self = shift; my ($state) = @_; my $runners = $state->{+RUNNERS} //= {}; my (%removed); for my $entry (values %$runners) { $entry->{remove} = 1 if $self->_entry_expired($entry); next unless $entry->{remove}; my $runner_id = $entry->{runner_id}; $self->{+UNREGISTERED} = 1 if $runner_id eq $self->{+RUNNER_ID}; delete $runners->{$runner_id}; $removed{$runner_id}++; } return \%removed; } sub allocate_slots { my $self = shift; my (%params) = @_; my $con = $params{con} or croak "'con' is required"; my $job_id = $params{job_id} or croak "'job_id' is required"; return $self->transaction(rw => '_allocate_slots', con => $con, job_id => $job_id); } sub assign_slots { my $self = shift; my (%params) = @_; my $job = $params{job} or croak "'job' is required"; return $self->transaction(rw => '_assign_slots', job => $job); } sub release_slots { my $self = shift; my (%params) = @_; my $job_id = $params{job_id} or croak "'job_id' is required"; return $self->transaction(rw => '_release_slots', job_id => $job_id); } sub _allocate_slots { my $self = shift; my ($state, %params) = @_; my $entry = $state->{runners}->{$self->{+RUNNER_ID}}; delete $entry->{_calc_cache}; my $job_id = $params{job_id}; my $con = $params{con}; my ($min, $max) = @$con; $self->_runner_todo($entry, $job_id => $max); my $allocated = $entry->{allocated}; # We have what we need already allocated return $entry->{allocated} = $max if $max <= $allocated; return $entry->{allocated} if $entry->{allocated} >= $min; # Our allocation, if any, is not big enough, free it so we do not have a # deadlock with all runner holding an insufficient allocation. $allocated = $entry->{allocated} = 0; my $calcs = $self->_runner_calcs($entry); for (0 .. 1) { $self->_redistribute($state) if $_; # Only run on second loop # Cannot do anything if we have no allotment or no available slots. # This will go to the next loop for a redistribution, or end the loop. my $allotment = $entry->{allotment} or next; my $available = $allotment - $calcs->{assigned} or next; # If we get here we have an allotment (not 0) but it does not mean the # minimum, so we have to skip the test. return -1 if $allotment < $min; next unless $available >= $min; return $entry->{allocated} = min($available, $max); } return 0; } sub _assign_slots { my $self = shift; my ($state, %params) = @_; my $entry = $state->{runners}->{$self->{+RUNNER_ID}}; delete $entry->{_calc_cache}; my $job = $params{job}; my $job_id = $job->{job_id}; my $allocated = $entry->{allocated}; $self->_runner_todo($entry, $job_id => -1); $job->{count} = $allocated; $job->{started} = time; $entry->{allocated} = 0; $entry->{assigned}->{$job->{job_id}} = $job; return $job; } sub _release_slots { my $self = shift; my ($state, %params) = @_; my $entry = $state->{runners}->{$self->{+RUNNER_ID}}; my $job_id = $params{job_id}; delete $entry->{assigned}->{$job_id}; delete $entry->{_calc_cache}; $self->_runner_todo($entry, $job_id => -1); # Reduce our allotment if it makes sense to do so. my $calcs = $self->_runner_calcs($entry); $entry->{allotment} = $calcs->{total} if $entry->{allotment} > $calcs->{total}; } sub _runner_todo { my $sef = shift; my ($entry, $job_id, $count) = @_; my $jobs = $entry->{jobs} //= {}; if ($count) { if ($count < 0) { $count = delete $jobs->{$job_id}; } else { $jobs->{$job_id} = $count; } } elsif ($job_id) { $count = $jobs->{$job_id}; } $entry->{todo} = sum0(values %$jobs); return $count; } sub _runner_calcs { my $self = shift; my ($runner) = @_; return $runner->{_calc_cache} if $runner->{_calc_cache}; my $max = min(grep {$_} $self->{+MAX_SLOTS_PER_RUN}, $runner->{max_slots}); my $assigned = sum0(map { $_->{count} } values %{$runner->{assigned} //= {}}); my $active = $runner->{allocated} + $assigned; my $total = $runner->{todo} + $active; my $wants = ($total >= $max) ? max($max, $active) : max($total, $active); return $runner->{_calc_cache} = { max => $max, assigned => $assigned, active => $active, total => $total, wants => $wants, }; } sub _redistribute { my $self = shift; my ($state) = @_; my $max_run = $self->{+MAX_SLOTS_PER_RUN}; my $wanted = 0; for my $runner (values %{$state->{+RUNNERS}}) { my $calcs = $self->_runner_calcs($runner); $runner->{allotment} = $calcs->{wants}; $wanted += $calcs->{wants}; } # Everyone gets what they want! my $max = $self->{+MAX_SLOTS}; return if $wanted <= $max; my $meth = $self->{+ALGORITHM}; return $self->$meth($state); } sub _redistribute_first { my $self = shift; my ($state) = @_; my $min = $self->{+MIN_SLOTS_PER_RUN}; my $max = $self->{+MAX_SLOTS}; my $c = 0; for my $runner (sort { $a->{added} <=> $b->{added} } values %{$state->{+RUNNERS}}) { my $calcs = $self->_runner_calcs($runner); my $wants = $calcs->{wants}; if ($max >= $wants) { $runner->{allotment} = $wants; } else { $runner->{allotment} = max($max, $min, 0); } $max -= $runner->{allotment}; $c++; } return; } sub _redistribute_fair { my $self = shift; my ($state) = @_; my $runs = scalar keys %{$state->{+RUNNERS}}; # Avoid a divide by 0 below. return unless $runs; my $total = $self->{+MAX_SLOTS}; my $min = $self->{+MIN_SLOTS_PER_RUN}; my $used = 0; for my $runner (values %{$state->{+RUNNERS}}) { my $calcs = $self->_runner_calcs($runner); # We never want less than the 'active' number my $set = $calcs->{active}; # If min is greater than the active number and there are todo tests, we # use the min instead. $set = $min if $set < $min && $runner->{todo}; $runner->{allotment} = $set; $used += $set; } my $free = $total - $used; return unless $free >= 1; # Is there a more efficient way to do this? Yikes! my @runners = values %{$state->{+RUNNERS}}; while ($free > 0) { @runners = sort { $a->{allotment} <=> $b->{allotment} || $a->{added} <=> $b->{added} } grep { my $c = $self->_runner_calcs($_); $c->{wants} > $_->{allotment} } @runners; $free--; $runners[0]->{allotment}++; } return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Resource::SharedJobSlots::State - shared state for job slots =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2022 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/Resource/SharedJobSlots.pm0000644000175000017500000002636515012417054025743 0ustar exodistexodistpackage Test2::Harness::Runner::Resource::SharedJobSlots; use strict; use warnings; our $VERSION = '1.000158'; use YAML::Tiny; use Test2::Harness::Runner::Resource::SharedJobSlots::State; use Test2::Harness::Runner::Resource::SharedJobSlots::Config; use Time::HiRes qw/time/; use List::Util qw/min/; use Carp qw/confess/; use parent 'Test2::Harness::Runner::Resource'; use Test2::Harness::Util::HashBase qw{ init(); return $self; } sub init { my $self = shift; my $settings = $self->{+SETTINGS}; my $sconf = Test2::Harness::Runner::Resource::SharedJobSlots::Config->find(settings => $settings); die "Could not find shared jobs config.\n" unless $sconf; my $runner_id; $runner_id = $self->{+RUNNER_ID} //= $settings->runner->runner_id if $settings->check_prefix('runner'); my $runner_pid = $self->{+RUNNER_PID} //= $Test2::Harness::Runner::RUNNER_PID // $App::Yath::Command::runner::RUNNER_PID; my $prefix = $settings->debug->procname_prefix // ''; my $name = $settings->harness->project // ''; my $dir; if (my $path = $settings->harness->config_file) { if ($path =~ m{^(.*)/[^/]+$}) { $dir = $1; } } $dir //= $settings->harness->cwd; unless ($name) { $name = $dir; $name =~ s{^.*/}{}; } $name = "$prefix-$name" if $prefix; $self->{+JOB_LIMITER_MAX} = min(grep { $_ } $sconf->max_slots_per_run, $settings->runner->job_count); $self->{+STATE} = Test2::Harness::Runner::Resource::SharedJobSlots::State->new( dir => $dir, name => $name, runner_id => $runner_id, runner_pid => $runner_pid, state_umask => $sconf->state_umask, state_file => $sconf->state_file, algorithm => $sconf->algorithm, max_slots => $sconf->max_slots, max_slots_per_job => $sconf->max_slots_per_job, max_slots_per_run => $sconf->max_slots_per_run, min_slots_per_run => $sconf->min_slots_per_run, default_slots_per_run => $sconf->default_slots_per_run, default_slots_per_job => $sconf->default_slots_per_job, my_max_slots => min($self->settings->runner->job_count, $sconf->max_slots), my_max_slots_per_job => min($self->settings->runner->slots_per_job, $sconf->max_slots_per_job), ); $self->{+CONFIG} = $sconf; return; } # Disable this short-circuit otherwise we may never queue a request! sub job_limiter_at_max { 0 } sub refresh { $_[0]->{+STATE}->update_registration } sub _job_concurrency { my $self = shift; my ($task) = @_; my $rmax = $self->settings->runner->job_count; my $jmax = $self->settings->runner->slots_per_job; my $srmax = $self->{+CONFIG}->max_slots_per_run; my $sjmax = $self->{+CONFIG}->max_slots_per_job; my $tmin = $task->{min_slots} // 1; my $tmax = $task->{max_slots} // $tmin; my $max = min($tmax, $sjmax, $srmax, $jmax, $rmax); # Invalid condition, minimum is more than our maximim return if $tmin > $max; $max = $tmin if $max < $tmin; return [$tmin, $max]; } sub available { my $self = shift; my ($task) = @_; my $con = $self->_job_concurrency($task); return -1 unless $con; my $granted = $self->{+STATE}->allocate_slots(con => $con, job_id => $task->{job_id}); return unless $granted; return $granted } sub assign { my $self = shift; my ($task, $state) = @_; return if $self->{+OBSERVE}; my $info = $self->{+STATE}->assign_slots( job => { job_id => $task->{job_id}, file => $task->{rel_file} // $task->{file} // $task->{job_name}, }, ); $state->{env_vars}->{T2_HARNESS_MY_JOB_CONCURRENCY} = $info->{count}; return $info; } sub record { } # NOOP sub release { my $self = shift; my ($job_id) = @_; return if $self->{+OBSERVE}; $self->{+STATE}->release_slots(job_id => $job_id); return; } sub status_data { my $self = shift; my @groups; my $runners = $self->state->state->{runners}; my $global_status = { todo => 0, allotted => 0, assigned => 0, pending => 0, }; my $time = time; for my $runner (sort { $a->{added} <=> $b->{added} } values %$runners) { my $run_status = { todo => $runner->{todo}, allotted => $runner->{allotment}, assigned => 0, pending => 0, }; my $job_table = { header => [qw/Runtime Slots Name/], format => ['duration', undef, undef], rows => [], }; for my $job (sort { $a->{started} <=> $b->{started} } values %{$runner->{assigned}}) { $run_status->{assigned} += $job->{count}; my $stamp = $job->{started}; my $slots = $job->{count}; push @{$job_table->{rows}} => [$time - $stamp, $slots, $job->{file} // $job->{job_id}]; } $run_status->{pending} = $runner->{allotment} - $run_status->{assigned}; $global_status->{$_} += $run_status->{$_} for keys %$global_status; my $run_table = { header => [qw/Todo Allotted Assigned Pending/], rows => [[$run_status->{todo}, $run_status->{allotted}, $run_status->{assigned}, $run_status->{pending}]], }; push @groups => { title => "$runner->{user} - $runner->{name} - $runner->{runner_id}", tables => [ $run_table, $job_table, ], }; } $global_status->{total} = $self->state->{max_slots}; $global_status->{free} = $global_status->{total} - ($global_status->{assigned} + $global_status->{pending}); $global_status->{free} = "$global_status->{free} (Minimum per-run overrides max slot count in some cases)" if $global_status->{free} < 0; unshift @groups => { title => 'System Wide Summary', tables => [ { header => ['Todo', 'Total Shared Slots', 'Allotted Shared Slots', 'Assigned Shared Slots', 'Pending Shared Slots', 'Free Shared Slots'], rows => [[ @{$global_status}{qw/todo total allotted assigned pending free/} ]], } ], }; return \@groups; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Resource::SharedJobSlots - limit the job count (-j) per machine =head1 SYNOPSIS B In order to use SharedJobSlots you must ether create the C<.sharedjobslots.yml> file, or provide the C<--shared-jobs-config PATH> argument on the command line. The C must be a path to a yaml file with configuration specifications for job sharing. =head1 CONFIG FILE Config files for shared slots must be yaml file, they must also be parsable by L, which implements a subset of yaml. Here is an example config file: --- DEFAULT: state_file: /tmp/yath-slot-state max_slots: 8 max_slots_per_job: 2 max_slots_per_run: 6 myhostname: state_file: /tmp/myhostname-slot-state max_slots: 16 max_slots_per_job: 4 max_slots_per_run: 12 =head2 TOP LEVEL KEYS (HOSTNAMES) All top level keys are hostnames. When the config is read the settings for the current hostname will be used. If the hostname is not defined then the C host will be read. If there is no C host defined an exception will be thrown. =head2 CONFIG OPTIONS Each option must be specified under a hostname, none of these are valid on their own. =over 4 =item state_file: /path/to/shared/state/file B This specifies the path to the shared state file. All yath processes by all users who are sharing slots need read+write access to this file. =item state_umask: 0007 Defaults to C<0007>. Used to set the umask of the state file as well as the lock file. =item max_slots: 8 Max slots system-wide for all users to share. =item max_slots_per_run: 4 Max slots a specific test run can use. =item min_slots_per_run: 0 Minimum slots per run. Set this if you want to make sure that all runs get at least N slots, B. This defaults to 0. =item max_slots_per_job: 2 Max slots a specific test job (test file) can use. =item default_slots_per_run: 4 If the user does not specify a number of slots, use this as the default. =item default_slots_per_job: 2 If the user does not specify a number of job slots, use this as the default. =item algorithm: fair =item algorithm: first =item algorithm: Fully::Qualified::Module::function_name Algorithm to use when assigning slots. 'fair' is the default. =back =head3 ALGORITHMS These are algorithms that are used to decide which test runs get which slots. =over 4 =item fair B This algorithm tries to balance slots so that all runs share an equal fraction of available slots. If there are not enough slots to go around then priority goes to oldest runs, followed by oldest requests. =item first Priority goes to the oldest run, followed by the next oldest, etc. If the run age is not sufficient to sort requests this will fall back to 'fair'. This is mainly useful for CI systems or batched test boxes. This will give priority to the first test run started, so additional test runs will not consume slots the first run wants to use, but if the first run is winding down and does not need all the slots, the second test run can start using only the spare slots. Use this with ordered test runs where you do not want a purely serial run order. =item Fully::Qualified::Module::function_name You can specify custom algorithms by giving fully qualified subroutine names. =back Example custom algorithm: sub custom_sort { my ($state_object, $state_data, $a, $b) = @_; return 1 if a_should_come_first($a, $b); return -1 if b_should_come_first($a, $b); return 0 if both_have_same_priority($a, $b); # *shrug* return 0; } Ultimately this is used in a C call, usual rules apply, return should be 1, 0, or -1. $a and $b are the 2 items being compared. $state_object is an instance of C. $state_data is a hashref like you get from C<< $state_object->state() >> which is useful if you want to know how many slots each runner is using for a 'fair' style algorth. Take a look at the C methods on C which implement the 3 original sorting methods. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2022 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/Resource/JobCount.pm0000644000175000017500000000653615012417054024576 0ustar exodistexodistpackage Test2::Harness::Runner::Resource::JobCount; use strict; use warnings; our $VERSION = '1.000158'; use parent 'Test2::Harness::Runner::Resource'; use Test2::Harness::Util::HashBase qw/init(); return $self; } sub init { my $self = shift; my $settings = $self->{+SETTINGS}; $self->{+JOB_COUNT} //= $settings ? $settings->runner->job_count // 1 : 1; $self->{+USED} //= {}; $self->{+FREE} //= [1 .. $self->{+JOB_COUNT}]; } sub job_limiter_max { my $self = shift; return $self->{+JOB_COUNT}; } sub job_limiter_at_max { my $self = shift; return 0 if @{$self->{+FREE}}; return 1; } sub available { my $self = shift; my ($task) = @_; my $rmin = $self->settings->runner->slots_per_job; my $tmin = $task->{min_slots} // 1; my $tmax = $task->{max_slots} // $tmin; return -1 if $self->{+JOB_COUNT} < $tmin; return -1 if $rmin < $tmin; my $concurrency = min(grep { $_ } $tmax, $rmin); $concurrency ||= 1; return 1 if @{$self->{+FREE}} >= $concurrency; return 0; } sub assign { my $self = shift; my ($task, $state) = @_; my $rmin = $self->settings->runner->slots_per_job; my $tmin = $task->{min_slots} // 1; my $tmax = $task->{max_slots} // $tmin; my $concurrency = min(grep { $_ } $tmax, $rmin); $concurrency ||= 1; $state->{record} = { count => $concurrency, file => $task->{rel_file}, stamp => time, }; $state->{env_vars}->{T2_HARNESS_MY_JOB_CONCURRENCY} = $concurrency; } sub record { my $self = shift; my ($job_id, $info) = @_; my $count = $info->{count}; my @use = splice @{$self->{+FREE}}, 0, $count; $info->{slots} = \@use; $self->{+USED}->{$job_id} = $info; } sub release { my $self = shift; my ($job_id) = @_; # Could be a free with no used slot. my $info = delete $self->{+USED}->{$job_id} or return; my $slots = $info->{slots}; push @{$self->{+FREE}} => @$slots; } sub status_data { my $self = shift; my @rows; my $time = time; for my $info (sort { $a->{stamp} <=> $b->{stamp} } values %{$self->{+USED}}) { my $count = @{$info->{slots} || []}; push @rows => [$time - $info->{stamp}, $count, $info->{file}]; } push @rows => [undef, scalar(@{$self->{+FREE}}), '** FREE **']; return [ { tables => [ { headers => [qw/Runtime Slots Name/], format => ['duration'], rows => \@rows, }, ], }, ], } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Resource::JobCount - limit the job count (-j) =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/Preloader/0000755000175000017500000000000015012417054022631 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Runner/Preloader/Stage.pm0000644000175000017500000000224615012417054024236 0ustar exodistexodistpackage Test2::Harness::Runner::Preloader::Stage; use strict; use warnings; our $VERSION = '1.000158'; use parent 'Test2::Harness::IPC::Process'; use Test2::Harness::Util::HashBase qw{ {+CATEGORY} //= 'stage' } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Preloader::Stage - Representation of a persistent stage process. =head1 DESCRIPTION This module is responsible for preloading libraries for a specific stage before running tests. This entire module is considered an "Implementation Detail". Please do not rely on it always staying the same, or even existing in the future. Do not use this directly. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/Preload/0000755000175000017500000000000015012417054022302 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Runner/Preload/Stage.pm0000644000175000017500000000703615012417054023711 0ustar exodistexodistpackage Test2::Harness::Runner::Preload::Stage; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use Test2::Harness::Util::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'; croak "There is already a watch on file '$file'" if $self->{+WATCHES}->{$file}; $self->{+WATCHES}->{$file} = $callback; return; } sub all_children { my $self = shift; my @out = @{$self->{+CHILDREN}}; for (my $i = 0; $i < @out; $i++) { my $it = $out[$i]; push @out => @{$it->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; } return @_; } 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::Harness::Runner::Preload::Stage - Abstraction of a preload stage. =head1 DESCRIPTION This is an implementation detail. You are not intended to directly use/modify instances of this class. See L for documentation on how to write a custom preload library. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/Constants.pm0000644000175000017500000000232715012417054023232 0ustar exodistexodistpackage Test2::Harness::Runner::Constants; use strict; use warnings; our $VERSION = '1.000158'; use Importer Importer => 'import'; our @EXPORT = qw/CATEGORIES DURATIONS/; use constant CATEGORIES => {general => 1, isolation => 1, immiscible => 1}; use constant DURATIONS => {long => 1, medium => 1, short => 1}; 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Constants - Constants shared between multiple runner modules. =head1 DESCRIPTION Export some common structures. =head1 SYNOPSIS use Test2::Harness::Runner::Constants qw/CATEGORIES DURATIONS/; if (CATEGORIES->{$cat}) { print "$cat is valid\n"; } else { print "$cat is not valid\n"; } =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/Preloader.pm0000644000175000017500000004002115012417054023164 0ustar exodistexodistpackage Test2::Harness::Runner::Preloader; use strict; use warnings; our $VERSION = '1.000158'; use B(); use Carp qw/confess croak/; use Fcntl qw/LOCK_EX LOCK_UN/; use Time::HiRes qw/time sleep/; use Test2::Harness::Util qw/open_file file2mod mod2file lock_file unlock_file clean_path/; use Test2::Harness::Runner::Reloader; use Test2::Harness::Runner::Preloader::Stage; use File::Spec(); use List::Util qw/pairgrep/; use Test2::Harness::Util::HashBase( qw{ {+PRELOADS} //= []; $self->{+BELOW_THRESHOLD} //= 0; return if $self->{+BELOW_THRESHOLD}; $self->{+MONITOR} = 1 if $self->{+RELOAD}; my $need_depmap = $self->{+RELOAD} || $self->{+MONITOR} || $self->{+DUMP_DEPMAP}; if ($need_depmap) { require Test2::Harness::Runner::DepTracer; $self->{+DTRACE} //= Test2::Harness::Runner::DepTracer->new(); } if ($self->{+MONITOR} || $self->{+RELOAD}) { $self->{+BLACKLIST} //= {}; $self->{+BLACKLIST_FILE} //= File::Spec->catfile($self->{+DIR}, 'BLACKLIST'); } $self->{+RELOADER} = Test2::Harness::Runner::Reloader->new( stat_min_gap => 2, notify_cb => sub { $self->_reload_cb_notify(@_) }, find_loaded_cb => sub { $self->_reload_cb_find_loaded(@_) }, should_watch_cb => sub { $self->_reload_cb_should_watch(@_) }, can_reload_cb => sub { $self->_reload_cb_can_reload(@_) }, reload_cb => sub { $self->_reload_cb_reload(@_) }, delete_symbol_cb => sub { $self->_reload_cb_delete_symbol(@_) }, ); } sub stage_check { my $self = shift; my ($stage) = @_; return 0 if $self->{+BELOW_THRESHOLD}; my $p = $self->{+STAGED} or return 0; return 1 if $stage eq 'NOPRELOAD'; return 1 if $p->stage_lookup->{$stage}; return 0; } sub task_stage { my $self = shift; my ($file, $wants) = @_; $wants //= ""; return 'default' if $self->{+BELOW_THRESHOLD}; return 'default' unless $self->{+STAGED}; return $wants if $wants && $self->stage_check($wants); my $stage = $self->{+STAGED}->file_stage($file) // $self->{+STAGED}->default_stage; return $stage; } sub preload { my $self = shift; croak "Already preloaded" if $self->{+DONE}; return 'default' if $self->{+BELOW_THRESHOLD}; my $preloads = $self->{+PRELOADS} or return 'default'; return 'default' unless @$preloads; require Test2::API; Test2::API::test2_start_preload(); # Not loading blacklist yet because any preloads in this list need to # happen regardless of the blacklist. if ($self->{+MONITOR} || $self->{+DTRACE}) { $self->_monitor_preload($preloads); } else { $self->_preload($preloads); } $self->{+DONE} = 1; } sub preload_stages { my $self = shift; return 'default' unless $self->{+STAGED}; return $self->_preload_stages('NOPRELOAD', @{$self->{+STAGED}->stage_list}); } sub _preload_stages { my $self = shift; my @stages = @_; my $name = 'base'; my @procs; while (my $stage = shift @stages) { $stage = $self->{+STAGED}->stage_lookup->{$stage} unless ref $stage || $stage eq 'NOPRELOAD'; my $proc = $self->launch_stage($stage); if ($proc) { push @procs => $proc; next; } # We are in the stage now, reset these if (ref $stage) { $name = $stage->name; @procs = (); @stages = @{$stage->children}; } else { # NOPRELOAD $name = $stage; @procs = (); @stages = (); } $self->start_stage($stage); } return($name, @procs); } sub launch_stage { my $self = shift; my ($stage) = @_; $stage = $self->{+STAGED}->stage_lookup->{$stage} unless ref $stage || $stage eq 'NOPRELOAD'; my $name = ref($stage) ? $stage->name : $stage; my $pid = fork(); return Test2::Harness::Runner::Preloader::Stage->new( pid => $pid, name => $name, ) if $pid; $0 .= "-$name"; $ENV{T2_HARNESS_STAGE} = $name; return; } sub start_stage { my $self = shift; my ($stage) = @_; if ($self->{+STAGED}) { if ($stage && !ref($stage)) { $stage = $self->{+STAGED}->stage_lookup->{$stage}; } } else { $stage = undef; } $self->{+STAGE} = $stage; $self->load_blacklist if $self->{+MONITOR}; # Localize these in case something we preload tries to modify them. local $SIG{INT} = $SIG{INT}; local $SIG{HUP} = $SIG{HUP}; local $SIG{TERM} = $SIG{TERM}; my $preloads = $stage ? $stage->load_sequence : []; my $meth = $self->{+MONITOR} || $self->{+DTRACE} ? '_monitor_preload' : '_preload'; $self->$meth($preloads, $stage->watches) if $preloads && @$preloads; $self->_monitor() if $self->{+MONITOR}; } sub get_stage_callback { my $self = shift; my ($name) = @_; my $stage = $self->{+STAGE} or return undef; return undef unless ref $stage; return $stage->$name; } sub _monitor_preload { my $self = shift; my ($preloads, $watch) = @_; my $block = {%{$self->blacklist}}; my $dtrace = $self->dtrace; $dtrace->start; $self->_preload($preloads, $block, $dtrace->my_require); $dtrace->add_callbacks(%$watch) if $watch; $dtrace->stop; return; } sub _preload { my $self = shift; my ($preloads, $block, $require_sub) = @_; $block //= {}; my %seen; for my $mod (@$preloads) { next if $seen{$mod}++; if (ref($mod) eq 'CODE') { next if eval { $mod->($block, $require_sub); 1 }; $self->{+MONITOR} ? warn $@ : die $@; next; } next if $block && $block->{$mod}; next if eval { $self->_preload_module($mod, $block, $require_sub); 1 }; $self->{+MONITOR} ? warn $@ : die $@; } return; } sub _preload_module { my $self = shift; my ($mod, $block, $require_sub) = @_; my $file = mod2file($mod); $require_sub ? $require_sub->($file) : require $file; return unless $mod->can('TEST2_HARNESS_PRELOAD'); die "You cannot load a Test2::Harness::Runner::Preload module from within another" if $self->{+DONE}; $self->{+STAGED} //= do { require Test2::Harness::Runner::Preload; Test2::Harness::Runner::Preload->new(); }; $self->{+STAGED}->merge($mod->TEST2_HARNESS_PRELOAD); return; } sub eager_stages { my $self = shift; return unless $self->{+STAGED}; return $self->{+STAGED}->eager_stages; } sub load_blacklist { my $self = shift; my $bfile = $self->{+BLACKLIST_FILE}; my $blacklist = $self->{+BLACKLIST}; return unless -f $bfile; my $fh = open_file($bfile, '<'); while(my $pkg = <$fh>) { chomp($pkg); $blacklist->{$pkg} = 1; } } sub _lock_blacklist { my $self = shift; return $self->{+BLACKLIST_LOCK} if $self->{+BLACKLIST_LOCK}; my $bl = lock_file($self->{+BLACKLIST_FILE}, '>>'); seek($bl,2,0); return $self->{+BLACKLIST_LOCK} = $bl; } sub _unlock_blacklist { my $self = shift; my $bl = delete $self->{+BLACKLIST_LOCK} or return; $bl->flush; unlock_file($bl); close($bl); return; } sub _notify { my $self = shift; for my $msg (@_) { print "$$ $0 - $msg\n"; } } sub _reload_cb_notify { my $self = shift; my ($type, $info) = @_; return $self->_notify("Runner detected a change in one or more preloaded modules...") if $type eq 'changes_detected'; return $self->_notify("Runner detected changes in file '$info'...") if $type eq 'file_changed'; return $self->_notify("Runner attempting to reload '$info->{file}' in place...") if $type eq 'reload_inplace'; return $self->_notify( "Runner failed to reload '$info->{file}' in place...", map { split /\n/, $_ } grep { $_ } @{$info->{warnings} // []}, $info->{error}, ) if $type eq 'reload_fail'; require Data::Dumper; local $Data::Dumper::Sortkeys = 1; local $Data::Dumper::Maxdepth = 2; return $self->_notify("Runner notification $type: " . (ref($info) ? Data::Dumper::Dumper($info) : $info) . "..."); } sub _reload_cb_find_loaded { keys %{$_[0]->dtrace->loaded} } sub _reload_cb_should_watch { my $self = shift; my ($reloader, $rel, $abs) = @_; my $dirs = $self->{+RESTRICT_RELOAD}; return 1 unless $dirs && @$dirs; for my $dir (@$dirs) { return 1 if 0 == index($abs, $dir); } return 0; } sub _reload_cb_can_reload { my $self = shift; my %params = @_; my $mod = $params{module}; my $file = $params{file}; return (0, reason => 'File is a yath preload module') if $mod->can('TEST2_HARNESS_PRELOAD'); if (my $cb = $self->get_stage_callback('reload_inplace_check')) { my ($res, %fields) = $cb->(module => $mod, file => $file); return ($res, %fields) if defined $res; } return (1) unless $mod->can('import'); return (0, reason => 'File is an importer') if $mod->can('IMPORTER_MENU'); { no strict 'refs'; return (0, reason => 'File is an importer') if @{"$mod\::EXPORT"}; return (0, reason => 'File is an importer') if @{"$mod\::EXPORT_OK"}; } return (1); } sub find_churn { my $self = shift; my ($file) = @_; # When a file is saved to disk it seems it can vanish temporarily. Use this loop to wait for it... my ($fh, $ok, $error); for (1 .. 50) { local $@; $ok = eval { $fh = open_file($file) }; $error = "LOOP $_: $@"; last if $ok; sleep 0.2; } die $error // "Unknown error opening file '$file'" unless $fh; my $active = 0; my @out; my $line_no = 0; while (my $line = <$fh>) { $line_no++; if ($active) { if ($line =~ m/^\s*#\s*HARNESS-CHURN-STOP\s*$/) { push @{$out[-1]} => $line_no; $active = 0; next; } else { $out[-1][-1] .= $line; next; } } if ($line =~ m/^\s*#\s*HARNESS-CHURN-START\s*$/) { $active = 1; push @out => [$line_no, '']; } } return @out; } sub _reload_cb_reload { my $self = shift; my %params = @_; my ($file, $rel, $mod) = @params{qw/file relative module/}; my $callbacks; if (my $dtrace = $self->dtrace) { $callbacks = $dtrace->callbacks; } $callbacks //= {}; if (my $cb = $callbacks->{$file} // $callbacks->{$rel}) { $self->_notify("Changed file '$rel' has a reload callback, executing it instead of regular reloading..."); my $ret = $cb->(); return (1, callback_return => $ret); } if (my @churn = $self->find_churn($file)) { $self->_notify("Changed file '$rel' contains churn sections, running them instead of a full reload..."); for my $churn (@churn) { my ($start, $code, $end) = @$churn; my $sline = $start + 1; if (eval "package $mod;\nuse strict;\nuse warnings;\nno warnings 'redefine';\n#line $sline $file\n$code\n ;1;") { $self->_notify("Success reloading churn block ($file lines $start -> $end)"); } else { $self->_notify("Error reloading churn block ($file lines $start -> $end): $@"); } } return (1); } return (0, reason => 'reloading disabled') unless $self->{+RELOAD}; return undef; } sub _reload_cb_delete_symbol { my $self = shift; my %params = @_; my $sym = $params{symbol}; my $mod = $params{module}; my $file = $params{file}; # Make sure the changed file and the file that defined the sub are the same. my $cb = $self->get_stage_callback('reload_remove_check') or return 0; my $sub = $mod->can($sym) or return 0; my $cobj = B::svref_2object($sub) or return 0; my $subfile = $cobj->FILE or return 0; my $res = $cb->( mod => $mod, sym => $sym, sub => $sub, from_file => -f $subfile ? clean_path($subfile) : $subfile, reload_file => -f $file ? clean_path($file) : $file, ); # 0 means do not skip, so if the cb returned true we do not skip return 0 if $res; return 1; } sub _monitor { my $self = shift; if ($self->{+MONITORED} && $self->{+MONITORED}->[0] == $$) { die "Monitor already starated\n" . "\n=======\n$0\n" . Carp::longmess() . "\n=====\n" . $self->{+MONITORED}->[1] . "\n" . $self->{+MONITORED}->[2] . "\n=======\n"; } $self->{+MONITORED} = [$$, $0, Carp::longmess()]; my $reloader = $self->{+RELOADER}; $reloader->reset(); $reloader->refresh(); return $self->{+MONITORED}; } sub check { my $self = shift; my ($state) = @_; return 1 if $self->{+CHANGED}; return 0 unless $self->{+MONITOR}; # Do not check for changes more often than 1 second (This is used in a loop that needs to be more often than once a second) return 0 if $self->{+LAST_UPDATE} && 1 > (time - $self->{+LAST_UPDATE}); $self->{+LAST_UPDATE} = time; my $dtrace = $self->dtrace; $dtrace->start if $self->{+RELOAD}; my $results = $self->{+RELOADER}->reload_changes(); $dtrace->stop if $self->{+RELOAD}; my (@todo, @fails); for my $item (values %$results) { my $stage = $self->{+STAGE} ? $self->{+STAGE}->name : 'default'; $state->reload($stage => $item); my $rel = $item->{reloaded}; next if $rel; # Reload success if (defined $rel) { # Not reloaded, but no error push @todo => $item; next; } } unless (@todo) { $self->{+RELOADER}->refresh(); return 0; } $self->{+CHANGED} = 1; $self->_notify("blacklisting changed files and reloading stage..."); my $bl = $self->_lock_blacklist(); my $dep_map = $self->dtrace->dep_map; my %CNI = reverse pairgrep { $b } %INC; my %seen; while (@todo) { my $item = shift @todo; my $ref = ref($item); my ($mod, $abs, $rel); if ($ref eq 'HASH') { ($mod, $abs, $rel) = @{$item}{qw/module file relative/}; } elsif ($ref eq 'ARRAY') { ($mod, $abs) = @$item; $rel = $CNI{$abs} || $abs; } else { die "Invalid ref type: $ref"; } next if $seen{$abs}++; next if $mod->can('TEST2_HARNESS_PRELOAD'); $self->_notify("Blacklisting $mod..."); print $bl "$mod\n"; my $next = $dep_map->{$abs} or next; push @todo => @$next; } $self->_unlock_blacklist(); return 1; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Preloader - Preload logic. =head1 DESCRIPTION This module is responsible for preloading libraries before running tests. This entire module is considered an "Implementation Detail". Please do not rely on it always staying the same, or even existing in the future. Do not use this directly. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/DepTracer.pm0000644000175000017500000001313615012417054023127 0ustar exodistexodistpackage Test2::Harness::Runner::DepTracer; use strict; use warnings; use Carp qw/croak/; our $VERSION = '1.000158'; use Test2::Harness::Util::HashBase qw/ -_on -exclude -dep_map -loaded -my_require -real_require -_my_inc -callbacks /; my %DEFAULT_EXCLUDE = ( 'warnings.pm' => 1, 'strict.pm' => 1, ); my $ACTIVE; sub ACTIVE { $ACTIVE } sub start { my $self = shift; croak "There is already an active DepTracer" if $ACTIVE; $ACTIVE = $self; unshift @INC => $self->my_inc; $self->{+_ON} = 1; } sub stop { my $self = shift; croak "DepTracer is not active" unless $ACTIVE; croak "Different DepTracer is active" unless "$ACTIVE" eq "$self"; $ACTIVE = undef; $self->{+_ON} = 0; my $inc = $self->{+_MY_INC} or return 0; @INC = grep { !(ref($_) && $inc == $_) } @INC; return 0; } sub my_inc { my $self = shift; return $self->{+_MY_INC} if $self->{+_MY_INC}; my $exclude = $self->{+EXCLUDE} ||= {%DEFAULT_EXCLUDE}; my $dep_map = $self->{+DEP_MAP} ||= {}; my $loaded = $self->{+LOADED} ||= {}; return $self->{+_MY_INC} ||= sub { my ($this, $file) = @_; return unless $self->{+_ON}; return unless $file =~ m/^[_a-z]/i; return if $exclude->{$file}; my $loaded_by = $self->loaded_by; push @{$dep_map->{$file}} => $loaded_by; $loaded->{$file}++; return; }; } sub clear_loaded { %{$_[0]->{+LOADED}} = () } my %REQUIRE_CACHE; sub add_callbacks { my $self = shift; my %watch = @_; for my $file (keys %watch) { my $cb = $watch{$file}; $self->add_callback($file => $cb); } } sub add_callback { my $self = shift; my ($file, $cb) = @_; $self->{+LOADED}->{$file}++; $self->{+CALLBACKS}->{$file} = $cb; } sub init { my $self = shift; my $exclude = $self->{+EXCLUDE} ||= { %DEFAULT_EXCLUDE }; my $stash = \%CORE::GLOBAL::; # We use a string in the reference below to prevent the glob slot from # being auto-vivified by the compiler. $self->{+REAL_REQUIRE} = exists $stash->{require} ? \&{'CORE::GLOBAL::require'} : undef; $self->{+CALLBACKS} //= {}; my $dep_map = $self->{+DEP_MAP} ||= {}; my $loaded = $self->{+LOADED} ||= {}; my $inc = $self->my_inc; my $require = $self->{+MY_REQUIRE} = sub { my ($file) = @_; my $loaded_by = $self->loaded_by; my $real_require = $self->{+REAL_REQUIRE}; unless($real_require) { my $caller = $loaded_by->[0]; $real_require = $REQUIRE_CACHE{$caller} ||= eval "package $caller; sub { CORE::require(\$_[0]) }" or die $@; } goto &$real_require unless $self->{+_ON}; if ($file =~ m/^[_a-z]/i) { unless ($exclude->{$file}) { push @{$dep_map->{$file}} => $loaded_by; $loaded->{$file}++; } } if (!ref($INC[0]) || $INC[0] != $inc) { @INC = ( $inc, grep { !(ref($_) && $inc == $_) } @INC, ); } local @INC = @INC[1 .. $#INC]; $real_require->(@_); }; { no strict 'refs'; no warnings 'redefine'; *{'CORE::GLOBAL::require'} = $require; } } sub loaded_by { my $level = 1; while(my @caller = caller($level++)) { next if $caller[0] eq __PACKAGE__; return [$caller[0], $caller[1]]; } return ['', '']; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::DepTracer - Tool for tracing module dependencies as they are loaded. =head1 DESCRIPTION This tool is used by Test2::Harness to build a graph of dependancies which can then be used to blacklist modified modules (and anything thatuses them) when they change under a preloaded runner. =head1 SYNOPSIS use Test2::Harness::Runner::DepTracer; my $dt = Test2::Harness::Runner::DepTracer->new(); $dt->start(); require Some::Thing; # You can always check for and retrieve an active DepTrace this way: my $dt_reference = Test2::Harness::Runner::DepTracer->ACTIVE; $dt->stop(); my $dep_map = $dt->dep_map; my $loaded_by = $dep_map->{'Some/Thing.pm'}; print "Some::Thing was directly or indirectly loaded by:\n" . join("\n" => @$loaded_by) . "\n"; =head1 ATTRIBUTES These can be specified at construction, and will be populated during use. =over 4 =item $hashref = $dt->exclude A hashref of files/modules to exclude from dep tracking. By default C and C are excluded. =item $hashref = $dt->dep_map Every file which is loaded while the tool is started will have an entry in this hash, each value is an array of all files which loaded the key file directly or indirectly. =item $hashref = $dt->loaded How many times each file was directly loaded. =back =head1 METHODS =over 4 =item $dt->start Start tracking modules which are loaded. =item $dt->stop Stop tracking moduels that are loaded. =back =head1 CLASS METHODS =over 4 =item $dt_or_undef = Test2::Harness::Runner::DepTracer->ACTIVE(); Get the currently active DepTracer, if any. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/Reloader.pm0000644000175000017500000001707715012417054023023 0ustar exodistexodistpackage Test2::Harness::Runner::Reloader; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use Time::HiRes qw/time/; use Test2::Harness::Util qw/file2mod is_same_file/; use File::Spec(); BEGIN { local $@; my $inotify = eval { require Linux::Inotify2; 1 }; if ($inotify) { my $MASK = Linux::Inotify2::IN_MODIFY(); $MASK |= Linux::Inotify2::IN_ATTRIB(); $MASK |= Linux::Inotify2::IN_DELETE_SELF(); $MASK |= Linux::Inotify2::IN_MOVE_SELF(); $MASK |= Linux::Inotify2::IN_MOVE_SELF(); *USE_INOTIFY = sub() { 1 }; require constant; constant->import(INOTIFY_MASK => $MASK); } else { *USE_INOTIFY = sub() { 0 }; *INOTIFY_MASK = sub() { 0 }; } } use Test2::Harness::Util::HashBase qw{ {+PID} //= $$; croak "PID has changed $$ vs $pid (Maybe you need to call reset()?)" unless $$ == $pid; return 1; } sub init { my $self = shift; $self->{+CAN_RELOAD_CB} //= $self->can('_can_reload'); $self->{+FIND_LOADED_CB} //= $self->can('_find_loaded'); $self->{+STAT_MIN_GAP} //= 2; $self->reset; } sub reset { my $self = shift; delete $self->{+PID}; $self->{+MONITORED} = {}; $self->{+MONITOR_LOOKUP} = {}; if (USE_INOTIFY) { $self->{+WATCHER} = Linux::Inotify2->new; $self->{+WATCHER}->blocking(0); } else { $self->{+WATCHER} = {}; } delete $self->{+STAT_LAST_CHECKED}; } sub _find_loaded { keys %INC } sub refresh { my $self = shift; $self->_pid_check(); my $monitored = $self->{+MONITORED}; my $cb = $self->{+FIND_LOADED_CB}; for my $file ($self->$cb($monitored)) { next if exists $monitored->{$file}; $self->monitor($file); } } sub monitor { my $self = shift; my ($file) = @_; $self->_pid_check(); my $monitored = $self->{+MONITORED}; return if exists $monitored->{$file}; my $watch = $self->find_file_to_watch($file); return $monitored->{$file} = 0 unless $watch && -e $watch; if (my $should_watch_cb = $self->{+SHOULD_WATCH_CB}) { return $monitored->{$file} = 0 unless $self->$should_watch_cb($file => $watch); } if (USE_INOTIFY) { my $inotify = $self->{+WATCHER}; $inotify->watch($watch, INOTIFY_MASK()); } else { my $stats = $self->{+WATCHER}; $stats->{$watch} = $self->_get_file_times($watch); } $self->{+MONITOR_LOOKUP}->{$watch} = $file; $monitored->{$file} = $watch; return $watch; } sub find_file_to_watch { my $self = shift; my ($file) = @_; return $INC{$file} if $INC{$file} && -e $INC{$file}; for my $dir (@INC) { next if ref($dir); my $path = File::Spec->catfile($dir, $file); return $path if -f $path; } return $file if -e $file; } sub _get_file_times { my $self = shift; my ($file) = @_; my (undef, undef, undef, undef, undef, undef, undef, undef, undef, $mtime, $ctime) = stat($file); return [$mtime, $ctime]; } sub _get_changes { my $self = shift; if (USE_INOTIFY) { my $inotify = $self->{+WATCHER}; my @todo = $inotify->read or return; return {map { ($_->fullname() => 1) } @todo}; } # Do not hammer the disk getting stat my $check_time = time; my $gap = $self->{+STAT_MIN_GAP}; my $last_checked = $self->{+STAT_LAST_CHECKED}; return if $last_checked && $gap && $gap > ($check_time - $last_checked); $last_checked = $check_time; my $found = 0; my $changed = {}; my $stats = $self->{+WATCHER}; for my $file (keys %$stats) { my $old_times = $stats->{$file}; my $new_times = $self->_get_file_times($file); # Compare times next if $old_times->[0] == $new_times->[0] && $old_times->[1] == $new_times->[1]; # Update in case we choose not to reload $stats->{$file} = $new_times; $found++; $changed->{$file} = 1; } return unless $found; return $changed; } sub _can_reload { my %params = @_; my $mod = $params{module}; return 1 unless $mod->can('import'); return 0 if $mod->can('IMPORTER_MENU'); { no strict 'refs'; return 0 if @{"$mod\::EXPORT"}; return 0 if @{"$mod\::EXPORT_OK"}; } return 1; } sub reload_changes { my $self = shift; $self->_pid_check(); my $monitored = $self->{+MONITORED}; $self->refresh(); my $changed = $self->_get_changes() or return; my $notify_cb = $self->{+NOTIFY_CB}; $notify_cb->(changes_detected => [keys %$changed]) if $notify_cb; my %out; for my $file (sort keys %$changed) { if (USE_INOTIFY) { my $inotify = $self->{+WATCHER}; $inotify->watch($file, INOTIFY_MASK()); } $notify_cb->(file_changed => $file) if $notify_cb; my $rel = $self->{+MONITOR_LOOKUP}->{$file}; my $mod = file2mod($rel); my %params = (reloader => $self, file => $file, relative => $rel, module => $mod, notify_cb => $notify_cb); my ($status, %fields) = $self->_reload_file(%params); $out{$file} = { file => $file, relative => $rel, module => $mod, reloaded => $status, %fields, }; } return \%out; } sub _reload_file { my $self = shift; my %params = @_; if (my $reload_cb = $self->{+RELOAD_CB}) { my ($status, %fields) = $reload_cb->(%params); return ($status, %fields) if defined $status; } if (my $can_reload_cb = $self->{+CAN_RELOAD_CB}) { my ($can, %fields) = $can_reload_cb->(%params); return ($can, %fields) unless $can; } my $notify_cb = delete $params{notify_cb}; $notify_cb->(reload_inplace => \%params) if $notify_cb; my $del_cb = $self->{+DELETE_SYMBOL_CB}; my ($file, $rel, $mod) = @params{qw/file relative module/}; my @warnings; my $ok = eval { local $SIG{__WARN__} = sub { push @warnings => @_ }; my $stash = do { no strict 'refs'; \%{"${mod}\::"} }; for my $sym (keys %$stash) { next if $sym =~ m/::$/; next if $del_cb && $del_cb->(%params, symbol => $sym, stash => $stash); delete $stash->{$sym}; } delete $INC{$rel}; local $.; require $rel; die "Reloading '$rel' loaded '$INC{$rel}' instead of '$file', \@INC must have been altered" unless is_same_file($file, $INC{$rel}); 1; }; my $err = $@; return (1) if $ok && !@warnings; $notify_cb->(reload_fail => {%params, warnings => \@warnings, error => $err}) if $notify_cb; return (undef, error => $err, warnings => \@warnings); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Reloader - reload logic. =head1 DESCRIPTION =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/Resource.pm0000644000175000017500000004505715012417054023054 0ustar exodistexodistpackage Test2::Harness::Runner::Resource; use strict; use warnings; use Term::Table; use Time::HiRes qw/time/; use Test2::Util::Times qw/render_duration/; our $VERSION = '1.000158'; sub scope_global { 0 } sub scope_host { 0 } sub scope_run { 1 } sub setup {} sub new { my $class = shift; return bless({@_}, $class); } sub tick { } sub refresh { } sub discharge { } sub sort_weight { my $class = shift; return 100 if $class->job_limiter; return 50; } sub job_limiter { 0 } sub job_limiter_max { } sub job_limiter_at_max { 0 } sub available { -1 } sub record { } sub assign { } sub release { } sub cleanup { } sub status_data {()} sub status_lines { my $self = shift; my $data = $self->status_data || return; return unless @$data; my $out = ""; for my $group (@$data) { my $gout = "\n"; $gout .= "**** $group->{title} ****\n\n" if defined $group->{title}; for my $table (@{$group->{tables} || []}) { my $rows = $table->{rows}; if (my $format = $table->{format}) { my $rows2 = []; for my $row (@$rows) { my $row2 = []; for (my $i = 0; $i < @$row; $i++) { my $val = $row->[$i]; my $fmt = $format->[$i]; $val = defined($val) ? render_duration($val) : '--' if $fmt && $fmt eq 'duration'; push @$row2 => $val; } push @$rows2 => $row2; } $rows = $rows2; } next unless $rows && @$rows; my $tt = Term::Table->new( header => $table->{header}, rows => $rows, sanitize => 1, collapse => 1, auto_columns => 1, %{$table->{term_table_opts} || {}}, ); $gout .= "** $table->{title} **\n" if defined $table->{title}; $gout .= "$_\n" for $tt->render; $gout .= "\n"; } if ($group->{lines} && @{$group->{lines}}) { $gout .= "$_\n" for @{$group->{lines}}; $gout .= "\n"; } $out .= $gout; } return $out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Resource - Base class for resource management classes =head1 DESCRIPTION Sometimes you have limited resources that must be shared/divided between tests that run concurrently. Resource classes give you a way to leverage the IPC system used by L to manage resource assignment and recovery. =head1 SYNOPSIS Here is a resource class that simply assigns an integer to each test. It would be possible to re-use integers, but since there are infinite integers this example is kept simple and just always grabs the next one. package Test2::Harness::Runner::Resource::Foo; use strict; use warnings; use parent 'Test2::Harness::Runner::Resource'; sub setup { my $class = shift; # NOT AN INSTANCE ... } sub available { my $self = shift; my ($task) = @_; # There are an infinite amount of integers, so we always return true return 1; } sub assign { my $self = shift; my ($task, $state) = @_; # Next ID, do not record the state change yet! my $id = 1 + ($self->{ID} //= 0); print "ASSIGN: $id = $task->{job_id}\n"; # 'record' should get whatever we need to record the resource, whatever you # pass in will become the argument to the record() sub below. This may be a # scalar, a hash, an array, etc. It will be serialized to JSON before # record() sees it. $state->{record} = $id; # Pass the resource into the test, this can be done as envronment variables # and/or arguments to the test (@ARGV). $state->{env_vars}->{FOO_ID} = $id; push @{$state->{args}} => $id; # The return is ignored. return; } sub record { my $self = shift; my ($job_id, $record_arg_from_assign) = @_; # The ID from $state->{record}->{$pkg} in assign. my $id = $record_arg_from_assign; # Update our internal state to reflect the new ID. $self->{ID} = $id; # Add a mapping of what job ID gets what integer ID. $self->{ID_TO_JOB_ID}->{$id} = $job_id; $self->{JOB_ID_TO_ID}->{$job_id} = $id; print "RECORD: $id = $job_id\n"; # The return is ignored } sub tick { my $self = shift; # This is called by only 1 process at a time and gives you a way to do # extra stuff at a regular interval without other processes trying to # do the same work at the same time. # For example, if a database is left in a dirty state after it is # released, you can fire off a cleanup action here knowing no other # process will run it at the same time. You can also be sure no record # messages will be sent while this sub is running as the process it # runs in has a lock. ... } sub release { my $self = shift; my ($job_id) = @_; # Clear the internal mapping, the integer ID is now free. Theoretically it # can be reused, but this example is not that complex. my $id = delete $self->{JOB_ID_TO_ID}->{$job_id}; # This is called for all tests that complete, even if they did not use # this resource, so we return if the job_id is not applicable. return unless defined $id; delete $self->{ID_TO_JOB_ID}->{$id}; print " FREE: $id = $job_id\n"; # The return is ignored } sub cleanup { my $self = shift; print "CLEANUP!\n"; } 1; The print statements generated will look like this when running 2 tests concurrently: yath test -R Foo -j2 t/testA.t t/testB.t [...] (INTERNAL) ASSIGN: 1 = 4F7CF5F6-E43F-11EA-9199-24FCBF610F44 (INTERNAL) RECORD: 1 = 4F7CF5F6-E43F-11EA-9199-24FCBF610F44 (INTERNAL) ASSIGN: 2 = E19CD98C-E436-11EA-8469-8DF0BF610F44 (INTERNAL) RECORD: 2 = E19CD98C-E436-11EA-8469-8DF0BF610F44 (INTERNAL) FREE: 1 = 4F7CF5F6-E43F-11EA-9199-24FCBF610F44 (INTERNAL) FREE: 2 = E19CD98C-E436-11EA-8469-8DF0BF610F44 (INTERNAL) CLEANUP! [...] Depending on the tests run the 'FREE' prints may be out of order. =head1 WORKFLOW =head2 HOW STATE IS MANAGED Depending on your preload configuration, yath may have several runners launching tests. If a runner has nothing to do it will lock the queue and try to find the next test that should be run. Only 1 of the runners will be in control of the queue at any given time, but the control of the queue may pass between runners. To manage this there is a mechanism to record messages that allow each runner to maintain a copy of the current state. =head2 CHECK IF RESOURCES ARE AVAILABLE Each runner will have an instance of your resource class. When the runner is in control of the queue, and wants to designate the next test to run, it will check with the resource classes to make sure the correct resources are available. To do that it will call C on each resource instance. The C<$task> will contain the specification for the test, it is a hashref, and you B modify it. The only key most people care about is the 'file' key, which has the test file that will be run if resources are available. If resources are available, or if the specific file does not need the resource, the C method should return true. If the file does need your resource(s), and none are available, this should return false. If any resource class returns false it means the test cannot be run yet and the runner will look for another test to run. =head2 ASSIGN A RESOURCE If the runner has determined the test can be run, and all necessary resources are available, it will then call C on all resource class instances. At this time the resource class should decide what resource(s) to assign to the class. B the C method B alter any internal state on the resource class instance. State modification must wait for the C method to be called. This is because the C method is only called in one runner process, the C method call will happen in every runner process to insure they all have the same internal state. The assign() sub should modify the C<$state> hash, which has 3 keys: =over 4 =item env_vars => {} Env vars to set for the test =item args => [] Arguments to pass to the test =item record => ... Data needed to record the state change for resource classes. Can be a scalar, hashref, arrayref, etc. It will be serialized to JSON to be passed between processes. =back =head2 RECORD A RESOURCE Once a resource is assigned, a message will be sent to all runner processes B that says it should call C on your resource class instance. Your resource class instance must use this to update the state so that once done ALL processes will have the proper internal state. The C<$record_val> is whatever you put into C<< $state->{record} >> in the C method above. =head2 QUEUE MANAGEMENT IS UNLOCKED Once the above has been done, queue management will be unlocked. You can be guarenteed that only one process will be run the C, and C sequence at a time, and that they will be called in order, though C may not be called if another resource was not available. If C is called, you can be guarenteed that all processes, including the one that called C will have their C called with the proper argument B they try to manage the queue (which is the only place resources are checked or assigned). =head2 RELEASE A RESOURCE Whenever a process that is using a resource exits, the runner that waits on that process will I send an IPC message announcing that the job_id has completed. Every time a job_id completes the C method will be called on your resource class in all runner processes. This allows the state to be updated to reflect the freed resource. You can be guarenteed that any process that locks the queue to run a new test will eventually see the message. The message may come in during a loop that is checking for resources, in which case the state will not reflect the resource being available, however in such cases the loop will end and be called again later with the message having been receieved. There will be no deadlock due to a queue manager waiting for the message. There are no guarentees about what order resources will be released in. =head1 METHODS =over 4 =item $class->setup($settings) This will be called once before the runner forks or initialized per-process instances. If you have any "setup once" tasks to initialize resources before tests run this is a good place to do it. This runs immedietly after plugin setup() methods are called. B Do not rely on recording any global state here, the runner and per-process instances may not be forked from the process that calls setup(). =item $res = $class->new(settings => $settings); A default new method, returns a blessed hashref with the settings key set to the L instance. =item $val = $res->available(\%task) B B Returns a positive true value if the resource is available. Returns false if the resource is not available, but will be in the future (IE in use by another test, but will be free when that test is done). Returns a negative value if the resource is not available and never will be. This will cause any tests dependent on the resource to be skipped. The only key in C<\%task> hashref that most resources will care about is the C<'file'> key, which contains the test file to be run. =item $res->assign(\%task, \%state) B B If the task does not need any resources you may simply return. If resources are needed you should deduce what resources to assign. You should put any data needed to update the internal state of your resource instance in the C<< $state->{record} >> hash key. It B be serialized to JSON before being used as an argument to C. $state->{record} = $id; If you do not set the 'record' key, or set it to undef, then the C method will not be called. If your tests need to know what resources to use, you may set environment variables and/or command line arguments to pass into the test (C<@ARGV>). $state->{env_vars}->{FOO_ID} = $id; push @{$state->{args}} => $id; The C<\%state> hashref is used only by your instance, you are free to fully replace the 'env_vars' and 'args' keys. They will eventually be merged into a master state along with those of other resources, but this ref is exclusive to you in this method. =item $inst->record($job_id, $record_arg_from_assign) B. This will be called in all processes so that your instance can update any internal state. The C<$job_id> variable contains the id for the job to which the resource was assigned. You should use this to record any internal state. The $job_id will be passed to C when the job completes and no longer needs the resource. This is intended only for modifying internal state, you should not do anything in this sub that will explode if it is also done in another process at the same time with the same arguments. For example creating a database should not be done here, multiple processes will fight to do the create. The creation, if necessary should be done in C which will be called in only one process. =item $inst->release($job_id) B. This will be called for every test job that completes, even if it did not use this resource. If the job_id did not use the resource you may simply return, otherwise update the internal state to reflect that the resource is no longer in use. This is intended only for modifying internal state, you should not do anything in this sub that will explode if it is also done in another process at the same time with the same arguments. For example deleting a database should not be done here, multiple processes will fight to do the delete. C is the only method that will be run in a single process, so if a database needs to be cleaned before it can be used you should clean it there. Any final cleanup should be done in C which will only be called by one process at the very end. =item $inst->cleanup() This will be called once by the parent runner process just before it exits. This is your chance to do any final cleanup tasks such as deleting databases that are no longer going to be used by tests as no more will be run. =item $inst->tick() This is called by only 1 process at a time and gives you a way to do extra stuff at a regular interval without other processes trying to do the same work at the same time. For example, if a database is left in a dirty state after it is released, you can fire off a cleanup action here knowing no other process will run it at the same time. You can also be sure no record messages will be sent while this sub is running as the process it runs in has a lock. =item $inst->refresh() Called once before each resource-request loop. This is your chance to do things between each set of requests for resources. =item $bool = $inst->job_limiter() True if your resource is intended as a job limiter (IE alternative to specifying -jN at the command line). =item $int = $inst->job_limiter_max() Max number of jobs this will allow at the moment, if this resource is a job limiter. =item $bool = $inst->job_limiter_at_max() True if the limiter has reached its maximum number of running jobs. This is used to avoid a resource-allocation loop as an optimization. =item $number = $inst->sort_weight() Used to sort resources if you want them to be checked in a specific order. For most resources this defaults to 50. For job_limiter resources this defaults to 100. Lower numbers are sorted to the front of the list, IE they are aquired first, before other resources. Job slots are sorted later (100) so that we do not try to grab a job slot if other resources are not available. Most of the time order will not matter, however with Shared job slots we have a race with other test runs to get slots, and checking availability is enough to consume a slot, even if other resources are not available. =item $string = $inst->status_lines() Get a (multi-line) string with status info for this resource. This is used to populate the output for the C command. The default implementation will build a string from the data provided by the C method. =item $arrayref = $inst->status_data() The default implementation returns an empty list. This should return status data that looks like this: return [ { title => "Resource Group Title", tables => [ { header => \@columns, rows => [ \@row1, \@row2, ], # Optional fields ################## # formatting for fields in rows format => [undef, undef, 'duration', ...], # Title for the table title => "Table Title", # Options to pass to Term::Table if/when it the data is used in Term::Table term_table_opts => {...}, }, # Any number of tables is ok {...}, ], }, # Any number of groups is ok {...}, ]; Currently the only supported formats are 'default' (undef), and 'duration'. Duration takes a stamp and tells you how much time has passed since the stamp. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/Preload.pm0000644000175000017500000003753415012417054022654 0ustar exodistexodistpackage Test2::Harness::Runner::Preload; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use Test2::Harness::Runner::Preload::Stage(); sub import { my $class = shift; my $caller = caller; my %exports; my $instance = $class->new; $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}; my $stage = $instance->stack->[-1]; $stage->set_eager(1); }; $exports{default} = sub { croak "No current stage" unless @{$instance->stack}; my $stage = $instance->stack->[-1]; my $name = $stage->name; $instance->set_default_stage($name); }; $exports{file_stage} = sub { my ($callback) = @_; my @caller = caller(); croak "'file_stage' cannot be used under a stage" if @{$instance->stack}; $instance->add_file_stage(\@caller, $callback); }; for my $name (qw/pre_fork post_fork pre_launch/) { my $meth = "add_${name}_callback"; $exports{$name} = sub { croak "No current stage" unless @{$instance->stack}; my $stage = $instance->stack->[-1]; $stage->$meth(@_); }; } $exports{watch} = sub { if (@{$instance->stack}) { my $stage = $instance->stack->[-1]; return $stage->watch(@_); } if ($INC{'Test2/Harness/Runner/DepTracer.pm'}) { if (my $active = Test2::Harness::Runner::DepTracer->ACTIVE) { return $active->add_callback(@_); } } croak "No current stage, and no active deptracer"; }; $exports{preload} = sub { croak "No current stage" unless @{$instance->stack}; my $stage = $instance->stack->[-1]; $stage->add_to_load_sequence(@_); }; $exports{reload_remove_check} = sub { croak "No current stage" unless @{$instance->stack}; my $stage = $instance->stack->[-1]; $stage->set_reload_remove_check(@_); }; $exports{reload_inplace_check} = sub { croak "No current stage" unless @{$instance->stack}; my $stage = $instance->stack->[-1]; $stage->set_reload_inplace_check(@_); }; for my $name (keys %exports) { no strict 'refs'; *{"$caller\::$name"} = $exports{$name}; } } use Test2::Harness::Util::HashBase qw{ {+STAGE_LIST} //= []; $self->{+STAGE_LOOKUP} //= {}; $self->{+STACK} //= []; $self->{+FILE_STAGE} //= []; } 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::Harness::Runner::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}) { $caller //= [caller()]; 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()]; for my $stage (@{$merge->{+STAGE_LIST}}) { $self->add_stage($stage, $caller); } push @{$self->{+FILE_STAGE}} => @{$merge->{+FILE_STAGE}}; $self->{+DEFAULT_STAGE} //= $merge->default_stage; } sub add_file_stage { my $self = shift; my ($caller, $code) = @_; croak "Caller must be defined and an array" unless $caller && ref($caller) eq 'ARRAY'; croak "Code must be defined and a coderef" unless $code && ref($code) eq 'CODE'; push @{$self->{+FILE_STAGE}} => [$caller, $code]; } sub file_stage { my $self = shift; my ($file) = @_; for my $cb (@{$self->{+FILE_STAGE}}) { my ($caller, $code) = @$cb; my $stage = $code->($file) or next; die "file_stage callback returned invalid stage: $stage at $caller->[1] line $caller->[2].\n" unless $self->{+STAGE_LOOKUP}->{$stage}; return $stage; } return; } 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::Harness::Runner::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 that let you go beyond that and build a more complex preload. In addition you can build multiple preload I, each stage will be its own process and tests can run from a specific stage. This allows for multiple different preload states from which to run tests. =head1 SYNOPSIS =head2 USING YOUR PRELOAD The C<-P> or C<--preload> options work for custom preload modules just as they do regular modules. Yath will know the difference and act accordingly. yath test -PMy::Preload =head2 WRITING YOUR PRELOAD package My::Preload; use strict; use warnings; # This imports several useful tools, and puts the necessary meta-data in # your package to identify it as a special preload. use Test2::Harness::Runner::Preload; # You must specify at least one stage. stage Moose => sub { # Preload can be called multiple times, and can load multiple modules # per call. Order is preserved. preload 'Moose', 'Moose::Role'; preload 'Scalar::Util', 'List::Util'; # preload can also be given a sub if you have some custom code to run # at a specific point in the load order preload sub { # Do something before loading Try::Tiny ... }; preload 'Try::Tiny'; # Tell the runner to watch this file for changes, if it does change run # the sub instead of the usual reload process. This lets you reload # configs and other non-perl files, or allows you to use a custom # reload sub for perl files. watch 'path/to/file' => sub { ... }; # You can also use watch inside preload subs: preload sub { watch 'path/to/file' => sub { ... }; }; # In app code you can add watches dynamically when applicable: preload sub { ... # inside app code if ($INC{'Test2/Harness/Runner/DepTracer.pm'}) { if (my $active = Test2::Harness::Runner::DepTracer->ACTIVE) { $active->add_callback('path/to/file' => sub { ... }); } } ... }; # Eager means tests from nested stages can be run in this stage as # well, this is useful if the nested stage takes a long time to load as # it allows yath to start running tests sooner instead of waiting for # the stage to finish loading. Once the nested stage is loaded tests # intended for it will start running from it instead. eager(); # default means this stage is the one to use if the test does not # specify a stage. default(); # These are hooks that let you run arbitrary code at specific points in # the process. pre_fork happens just before forking to run a test. # post_fork happens just after forking for a test. pre_launch happens # as late as possible before the test starts executing (post fork, # after $0 and other special state are reset). pre_fork sub { ... }; post_fork sub { ... }; pre_launch sub { ... }; # Stages can be nested, nested ones build off the previous stage, but # are in a forked process to avoid contaminating the parent. stage Types => sub { preload 'MooseX::Types'; }; }; # Alternative stage that loads Moo instead of Moose stage Moo => sub { preload 'Moo'; ... }; =head2 HARNESS DIRECTIVES IN PRELOADS If you use a staged preload, and the --reload option, you can add 'CHURN' directives to files in order to only reload sections you are working on. This is particularly useful when a file cannot be reloaded in full, or when doing so is expensive. You can wrap subroutines in the churn directives to have yath reload only those subroutines. sub do_not_reload_this { ... { # HARNESS-CHURN-START sub reload_this_one { ... } sub reload_this_one_too { ... } # HARNESS-CHURN-STOP sub this_is_not_reloaded { ... } You can put as many churn sections you want in as many preloaded modules as you want. If a change is detected then only the churn sections will be reloaded. The churn sections are reloaded by taking the source between the start and stop markers, and running them in an eval like this: eval < statement inside the markers. If the strict/warnings settings are not to your specifications you can add overrides inside the markers. Any valid perl code can go into the markers. B Be aware they do not have their original scope, and that can lead to problems if you are not paying attention. Variables outside your markers are not accessible, and lexical variables put inside your markers will be "new" on each reload, this can cause confusion if you have lexicals used by multiple subs where some are inside churn blocks and others are not, so best not to do that. Package variables work a bit better, but any assignment lines are re-run. So C is fine (it does not change the value if it is set) but C will reset the var on each reload. =head1 EXPORTS =over 4 =item $meta = TEST2_HARNESS_PRELOAD() =item $meta = $class->TEST2_HARNESS_PRELOAD() This export provides the meta object, which is an instance of this class. This method being present is how Test2::Harness differentiates between a regular module and a special preload library. =item stage NAME => sub { ... } This creates a new stage with the given C, and then runs the coderef with the new stage set as the I one upon which the other function here will operate. Once the coderef returns the I stage is cleared. You may nest stages by calling this function again inside the codeblock. B stage names B case sensitive. This can be confusing when you consider that most harness directives are all-caps. In the following case the stage requested by the test and the stage defined in the library are NOT the same. In a test file: # HARNESS-STAGE-FOO In a preload library: stage foo { ... } Harness directives are all-caps, however the user data portion need not be, this is fine: # HARNESS-STAGE-foo However it is very easy to make the mistake of thinking it is case insensitive. It is also easy to assume the 'foo' part of the harness directive must be all caps. In many cases it is smart to make your stage names all-caps. =item preload $module_name =item preload @module_names =item preload sub { ... } This B be called inside a C builder coderef. This adds modules to the list of libraries to preload. Order is preserved. You can also add coderefs to execute arbitrary code between module loads. The coderef is called with no arguments, and its return is ignored. =item eager() This B be called inside a C builder coderef. This marks the I stage as being I. An eager stage will start running tests for nested stages if it finds itself with no tests of its own to run before the nested stage can finish loading. The idea here is to avoid unused test slots when possible allowing for tests to complete sooner. =item default() This B be called inside a C builder coderef. This B be called only once across C stages in a given library. If multiple preload libraries are loaded then the I default set (based on load order) will be the default, others will notbe honored. =item $stage_name = file_stage($test_file) This is optional. If defined this callback will have a chance to look at all files that are going to be run and assign them a stage. This may return undef or an empty list if it does not have a stage to assign. If multiple preload libraries define file_stage callbacks they will be called in order, the first one to return a stage name will win. If no file_stage callbacks provide a stage for a file then any harness directives declaring a stage will be honored. If no stage is ever assigned then the test will be run int he default stage. =item pre_fork sub { ... } This B be called inside a C builder coderef. Add a callback to be run just before the preload-stage process forks to run the test. Note that any state changes here can effect future tests to be run. =item post_fork sub { ... } This B be called inside a C builder coderef. Add a callback to be run just after the preload-stage process forks to run the test. This is run as early as possible, things like C<$0> may not be set properly yet. =item pre_launch sub { ... } This B be called inside a C builder coderef. Add a callback to be run just before control of the test process is turned over to the test file itself. This is run as late as possible, so things like C<$0> should be set properly. =back =head1 META-OBJECT This class is also the meta-object used to construct a preload library. The methods are left undocumented as this is an implementation detail and you are not intended to directly use this object. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/Spawn.pm0000644000175000017500000000270715012417054022350 0ustar exodistexodistpackage Test2::Harness::Runner::Spawn; use strict; use warnings; our $VERSION = '1.000158'; use parent 'Test2::Harness::Runner::Job'; use Test2::Harness::Util::HashBase; sub init { my $self = shift; $self->{+RUN} //= Test2::Harness::Runner::Spawn::Run->new(); } sub out_file { sprintf('/proc/%i/fd/1', $_[0]->{+TASK}->{owner}) } sub err_file { sprintf('/proc/%i/fd/2', $_[0]->{+TASK}->{owner}) } sub in_file { undef } sub args { @{$_[0]->{+TASK}->{args} //= []} } sub job_dir { "" } sub run_dir { "" } sub use_stream { 0 } sub event_uuids { 0 } sub mem_usage { 0 } sub io_events { 0 } # These return lists sub load_import { } sub load { } package Test2::Harness::Runner::Spawn::Run; sub new { bless {}, shift }; sub env_vars { {} } sub AUTOLOAD { } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Spawn - Minimal job class used for spawning processes =head1 DESCRIPTION Do not use this directly... =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/State.pm0000644000175000017500000005247715012417054022351 0ustar exodistexodistpackage Test2::Harness::Runner::State; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use File::Spec; use Time::HiRes qw/time/; use List::Util qw/first/; use Test2::Harness::Util qw/mod2file/; use Test2::Harness::Settings; use Test2::Harness::Runner::Constants; use Test2::Harness::Runner::Run; use Test2::Harness::Util::Queue; use Test2::Harness::Util::UUID qw/gen_uuid/; use Test2::Harness::Util::HashBase( # These are construction arguments qw{ {+WORKDIR}; $self->{+JOB_COUNT} //= $self->settings->runner->job_count // 1; if (!$self->{+RESOURCES} || !@{$self->{+RESOURCES}}) { my $settings = $self->settings; my $resources = $self->{+RESOURCES} //= []; for my $res (@{$self->settings->runner->resources}) { require(mod2file($res)); push @$resources => $res->new(settings => $self->settings, observe => $self->{+OBSERVE}); } } unless (grep { $_->job_limiter } @{$self->{+RESOURCES}}) { require Test2::Harness::Runner::Resource::JobCount; push @{$self->{+RESOURCES}} => Test2::Harness::Runner::Resource::JobCount->new(job_count => $self->{+JOB_COUNT}, settings => $self->settings); } @{$self->{+RESOURCES}} = sort { $a->sort_weight <=> $b->sort_weight } @{$self->{+RESOURCES}}; $self->{+DISPATCH_FILE} = Test2::Harness::Util::Queue->new(file => File::Spec->catfile($self->{+WORKDIR}, 'dispatch.jsonl')); $self->{+RELOAD_STATE} //= {}; $self->poll; } sub settings { my $self = shift; return $self->{+SETTINGS} //= Test2::Harness::Settings->new(File::Spec->catfile($self->{+WORKDIR}, 'settings.json')); } sub run { my $self = shift; return $self->{+RUN} if $self->{+RUN}; $self->poll(); return $self->{+RUN}; } sub done { my $self = shift; $self->poll(); return 0 if $self->{+RUNNING}; return 0 if keys %{$self->{+PENDING_TASKS} //= {}}; return 0 if $self->{+RUN}; return 0 if @{$self->{+PENDING_RUNS} //= []}; return 0 unless $self->{+QUEUE_ENDED}; return 1; } sub next_task { my $self = shift; my ($stage) = @_; $self->poll(); $self->clear_finished_run(); while(1) { if (@{$self->{+PENDING_SPAWNS} //= []}) { my $spawn = shift @{$self->{+PENDING_SPAWNS}}; next unless $spawn->{stage} eq $stage; $self->start_spawn($spawn); return $spawn; } my $task = shift @{$self->{+TASK_LIST}} or return undef; # If we are replaying a state then the task may have already completed, # so skip it if it is not in the running lookup. next unless $self->{+RUNNING_TASKS}->{$task->{job_id}}; next unless $task->{stage} eq $stage; return $task; } } sub advance { my $self = shift; $self->poll(); $_->tick() for @{$self->{+RESOURCES} //= []}; $self->advance_run(); return 0 unless $self->{+RUN}; return 1 if $self->advance_tasks(); return $self->clear_finished_run(); } my %ACTIONS = ( queue_run => '_queue_run', queue_task => '_queue_task', queue_spawn => '_queue_spawn', start_spawn => '_start_spawn', start_run => '_start_run', start_task => '_start_task', stop_run => '_stop_run', stop_task => '_stop_task', retry_task => '_retry_task', stage_ready => '_stage_ready', stage_down => '_stage_down', end_queue => '_end_queue', halt_run => '_halt_run', truncate => '_truncate', reload => '_reload', ); sub poll { my $self = shift; return if $self->{+NO_POLL}; my $queue = $self->dispatch_file; for my $item ($queue->poll) { my $data = $item->[-1]; my $item = $data->{item}; my $action = $data->{action}; my $pid = $data->{pid}; my $sub = $ACTIONS{$action} or die "Invalid action '$action'"; $self->$sub($item, $pid); } } sub _enqueue { my $self = shift; my ($action, $item) = @_; $self->{+DISPATCH_FILE}->enqueue({action => $action, item => $item, stamp => time, pid => $$}); $self->poll; } sub truncate { my $self = shift; $self->halt_run($_) for keys %{$self->{+PENDING_TASKS} // {}}; $self->_enqueue(truncate => $$); $self->poll; } sub _truncate { } sub end_queue { $_[0]->_enqueue('end_queue' => 1) } sub _end_queue { $_[0]->{+QUEUE_ENDED} = 1 } sub halt_run { my $self = shift; my ($run_id) = @_; $self->_enqueue(halt_run => $run_id); my $dir = File::Spec->catdir($self->{+WORKDIR}, $run_id); my $file = File::Spec->catfile($dir, 'jobs.jsonl'); if (-f $file) { my $queue = Test2::Harness::Util::Queue->new(file => File::Spec->catfile($dir, 'jobs.jsonl')); $queue->end; } } sub _halt_run { my $self = shift; my ($run_id) = @_; delete $self->{+PENDING_TASKS}->{$run_id}; $self->{+HALTED_RUNS}->{$run_id}++; } sub queue_run { my $self = shift; my ($run) = @_; $self->_enqueue(queue_run => $run); } sub _queue_run { my $self = shift; my ($run) = @_; push @{$self->{+PENDING_RUNS}} => Test2::Harness::Runner::Run->new( %$run, workdir => $self->{+WORKDIR}, ); return; } sub start_run { my $self = shift; my ($run_id) = @_; $self->_enqueue(start_run => $run_id); } sub _start_run { my $self = shift; my ($run_id) = @_; my $run = shift @{$self->{+PENDING_RUNS}}; die "$0 - Run stack mismatch, run start requested, but no pending runs to start" unless $run; die "$0 - Run stack mismatch, run-id does not match next pending run" unless $run->run_id eq $run_id; $self->{+RUN} = $run; return; } sub stop_run { my $self = shift; my ($run_id) = @_; $self->_enqueue(stop_run => $run_id); } sub _stop_run { my $self = shift; my ($run_id) = @_; $self->{+STOPPED_RUNS}->{$run_id} = 1; return; } sub queue_spawn { my $self = shift; my ($spawn) = @_; $spawn->{spawn} //= 1; $spawn->{id} //= gen_uuid(); $self->_enqueue(queue_spawn => $spawn); } sub _queue_spawn { my $self = shift; my ($spawn) = @_; $spawn->{id} //= gen_uuid(); $spawn->{spawn} //= 1; $spawn->{use_preload} //= 1; $spawn->{stage} //= 'default'; $spawn->{stage} = $self->task_stage($spawn); push @{$self->{+PENDING_SPAWNS}} => $spawn; return; } sub start_spawn { my $self = shift; my ($spec) = @_; $self->_enqueue(start_spawn => $spec); } sub _start_spawn { my $self = shift; my ($spec) = @_; my $uuid = $spec->{id} or die "Could not find UUID for spawn"; @{$self->{+PENDING_SPAWNS}} = grep { $_->{id} ne $uuid } @{$self->{+PENDING_SPAWNS}}; return; } sub queue_task { my $self = shift; my ($task) = @_; $self->_enqueue(queue_task => $task); } sub _queue_task { my $self = shift; my ($task) = @_; my $job_id = $task->{job_id} or die "Task missing job_id"; my $run_id = $task->{run_id} or die "Task missing run_id"; die "Task already in queue" if $self->{+TASK_LOOKUP}->{$job_id}; return if $self->{+HALTED_RUNS}->{$run_id}; $self->{+TASK_LOOKUP}->{$job_id} = $task; my $pending = $self->task_pending_lookup($task); push @{$pending} => $task; return; } sub start_task { my $self = shift; my ($spec) = @_; $self->_enqueue(start_task => $spec); } sub _start_task { my $self = shift; my ($spec) = @_; my $job_id = $spec->{job_id} or die "No job_id provided"; my $run_stage = $spec->{stage} or die "No stage provided"; my $res = $spec->{res} or die "No res provided"; my $res_skip = $spec->{resource_skip}; my $task = $self->{+TASK_LOOKUP}->{$job_id} or die "Could not find task to start"; my ($run_id, $smoke, $stage, $cat, $dur) = $self->task_fields($task); my $set = $self->{+PENDING_TASKS}->{$run_id}->{$smoke}->{$stage}->{$cat}->{$dur}; my $count = @$set; @$set = grep { $_->{job_id} ne $job_id } @$set; die "Task $job_id was not pending ($count -> " . scalar(@$set) . ")" unless $count > @$set; $self->prune_hash($self->{+PENDING_TASKS}, $run_id, $smoke, $stage, $cat, $dur); # Set the stage, new task hashref $task = {%$task, stage => $run_stage} unless $task->{stage} && $task->{stage} eq $run_stage; $task->{env_vars}->{$_} = $res->{env_vars}->{$_} for keys %{$res->{env_vars}}; push @{$task->{test_args}} => @{$res->{args}}; for my $resource (@{$self->{+RESOURCES}}) { my $class = ref($resource); my $val = $res->{record}->{$class} // next; $resource->record($task->{job_id}, $val); } die "Already running task $job_id" if $self->{+RUNNING_TASKS}->{$job_id}; $self->{+RUNNING_TASKS}->{$job_id} = $task; $task->{resource_skip} = $res_skip if $res_skip; push @{$self->{+TASK_LIST}} => $task; $self->{+RUNNING}++; $self->{+RUNNING_CATEGORIES}->{$cat}++; $self->{+RUNNING_DURATIONS}->{$dur}++; my $cfls = $task->{conflicts} //= []; for my $cfl (@$cfls) { die "Unexpected parallel conflict '$cfl' ($self->{+RUNNING_CONFLICTS}->{$cfl}) running at this time!" if $self->{+RUNNING_CONFLICTS}->{$cfl}++; } return; } sub stop_task { my $self = shift; my ($job_id) = @_; $self->_enqueue(stop_task => $job_id); } sub _stop_task { my $self = shift; my ($job_id) = @_; my $task = delete $self->{+TASK_LOOKUP}->{$job_id} or die "Could not find task to stop ($job_id)"; delete $self->{+RUNNING_TASKS}->{$job_id} or die "Task is not running, cannot stop it ($job_id)"; $_->release($job_id) for @{$self->{+RESOURCES}}; my ($run_id, $smoke, $stage, $cat, $dur) = $self->task_fields($task); $self->{+RUNNING}--; $self->{+RUNNING_CATEGORIES}->{$cat}--; $self->{+RUNNING_DURATIONS}->{$dur}--; my $cfls = $task->{conflicts} //= []; $self->{+RUNNING_CONFLICTS}->{$_}-- for @$cfls; return; } sub retry_task { my $self = shift; my ($job_id) = @_; $self->_enqueue(retry_task => $job_id); } sub _retry_task { my $self = shift; my ($job_id) = @_; my $task = $self->{+TASK_LOOKUP}->{$job_id} or die "Could not find task to retry"; $self->_stop_task($job_id); return if $self->{+HALTED_RUNS}->{$task->{run_id}}; $task = {is_try => 0, %$task}; $task->{is_try}++; $task->{category} = 'isolation' if $self->{+RUN}->retry_isolated; $self->_queue_task($task); return; } sub stage_ready { my $self = shift; my ($stage) = @_; $self->_enqueue(stage_ready => $stage); } sub _stage_ready { my $self = shift; my ($stage, $pid) = @_; $self->{+STAGE_READINESS}->{$stage} = $pid // 1; return; } sub stage_down { my $self = shift; my ($stage) = @_; $self->_enqueue(stage_down => $stage); } sub _stage_down { my $self = shift; my ($stage) = @_; $self->{+STAGE_READINESS}->{$stage} = 0; return; } sub reload { my $self = shift; my ($stage, $data) = @_; $stage //= 'default'; $self->_enqueue(reload => {%$data, stage => $stage}); return; } sub _reload { my $self = shift; my ($data) = @_; my $stage = $data->{stage}; my $file = $data->{file}; my $success = $data->{reloaded}; my $error = $data->{error}; my $warnings = $data->{warnings}; my $reload_state = $self->{+RELOAD_STATE} //= {}; my $stage_state = $reload_state->{$stage} //= {}; # It either succeeded, or the stage will be reloaded, no need to track brokenness if (defined $success) { delete $stage_state->{$file}; } else { my $fields = {}; $fields->{error} = $error if defined($error) && length($error); $fields->{warnings} = $warnings if $warnings && @{$warnings}; if (keys %$fields) { $stage_state->{$file} = $fields; } else { delete $stage_state->{$file}; } } return; } sub task_stage { my $self = shift; my ($task) = @_; my $wants = $task->{stage}; $wants //= 'NOPRELOAD' unless $task->{use_preload}; return $wants if $self->{+NO_POLL}; return $wants // 'DEFAULT' unless $self->preloader; return $self->preloader->task_stage($task->{file}, $wants); } sub task_pending_lookup { my $self = shift; my ($task) = @_; my ($run_id, $smoke, $stage, $cat, $dur) = $self->task_fields($task); return $self->{+PENDING_TASKS}->{$run_id}->{$smoke}->{$stage}->{$cat}->{$dur} //= []; } sub task_fields { my $self = shift; my ($task) = @_; my $run_id = $task->{run_id} or die "No run id provided by task"; my $smoke = $task->{smoke} ? 'smoke' : 'main'; my $stage = $self->task_stage($task); my $cat = $task->{category}; my $dur = $task->{duration}; die "Invalid category: $cat" unless CATEGORIES->{$cat}; die "Invalid duration: $dur" unless DURATIONS->{$dur}; $cat = 'conflicts' if $cat eq 'general' && $task->{conflicts} && @{$task->{conflicts}}; return ($run_id, $smoke, $stage, $cat, $dur); } sub prune_hash { my $self = shift; my ($hash, @path) = @_; die "No path!" unless @path; my $key = shift @path; if (@path) { my $empty = $self->prune_hash($hash->{$key}, @path); return 0 unless $empty; } return 1 unless exists $hash->{$key}; my $ref = ref($hash->{$key}); if ($ref eq 'HASH') { return 0 if keys %{$hash->{$key}}; } elsif ($ref eq 'ARRAY') { return 0 if @{$hash->{$key}}; } delete $hash->{$key}; return 1; } sub advance_run { my $self = shift; return 0 if $self->{+RUN}; return 0 unless @{$self->{+PENDING_RUNS} //= []}; $self->start_run($self->{+PENDING_RUNS}->[0]->run_id); return 1; } sub clear_finished_run { my $self = shift; my $run = $self->{+RUN} or return 0; return 0 unless $self->{+STOPPED_RUNS}->{$run->run_id}; return 0 if $self->{+PENDING_TASKS}->{$run->run_id}; return 0 if $self->{+RUNNING}; delete $self->{+RUN}; return 1; } sub advance_tasks { my $self = shift; for my $resource (@{$self->{+RESOURCES}}) { $resource->refresh(); next unless $resource->job_limiter; return 0 if $resource->job_limiter_at_max(); } my ($run_stage, $task, $res, %params) = $self->_next(); my $out = 0; if ($task) { $out = 1; $self->start_task({job_id => $task->{job_id}, stage => $run_stage, res => $res, %params}); } $_->discharge() for @{$self->{+RESOURCES}}; return $out; } sub _cat_order { my $self = shift; my @cat_order = ('conflicts', 'general'); # Only search immiscible if we have no immiscible running # put them first if no others are running so we can churn through them # early instead of waiting for them to run 1 at a time at the end. unshift @cat_order => 'immiscible' unless $self->{+RUNNING_CATEGORIES}->{immiscible}; # Only search isolation if nothing is running. push @cat_order => 'isolation' unless $self->{+RUNNING}; return \@cat_order; } sub _dur_order { my $self = shift; my $max = 0; for my $resource (@{$self->resources}) { next unless $resource->job_limiter; my $val = $resource->job_limiter_max; $max = $val if !$max || $val < $max; } $max //= 1; my $maxm1 = $max - 1; my $durs = $self->{+RUNNING_DURATIONS}; # 'short' is always ok. my @dur_order = ('short'); # long and medium should be on the front of the search unless we are # already running (max - 1) tests of the duration We want long first if # we are not saturation on them, followed by medium, whcih is why they # are listed in this order. for my $c (qw/medium long/) { if ($durs->{$c} && $durs->{$c} >= $maxm1) { push @dur_order => $c; # Back of the list } else { unshift @dur_order => $c; # Front of the list } } return \@dur_order; } # This returns a list of [STAGE => RUN_STAGE] pairs. 'STAGE' is the stage in # which we search for tasks, 'RUN_STAGE' is the stage that actually does the # work. This is what allows us to find tasks for 'eager' stages that are bored. sub _stage_order { my $self = shift; my $stage_check = $self->{+STAGE_READINESS} //= {}; my @stage_list = sort grep { $stage_check->{$_} } keys %$stage_check; # Populate list with all ready stages my %seen; my @stages = map {[$_ => $_]} grep { !$seen{$_}++ } @stage_list; # Add in any eager stages, but make sure they are last. for my $rstage (@stage_list) { next unless exists $self->{+EAGER_STAGES}->{$rstage}; push @stages => map {[$_ => $rstage]} grep { !$seen{$_}++ } @{$self->{+EAGER_STAGES}->{$rstage}}; } return \@stages; } my %SORTED; sub _next { my $self = shift; my $run = $self->{+RUN} or return; my $run_id = $run->run_id; my $pending = $self->{+PENDING_TASKS}->{$run_id} or return; my $conflicts = $self->{+RUNNING_CONFLICTS}; my $cat_order = $self->_cat_order; my $dur_order = $self->_dur_order; my $stages = $self->_stage_order(); my $resources = $self->{+RESOURCES}; # Ugly.... my $search = $pending; for my $smoke (qw/smoke main/) { my $search = $search->{$smoke} or next; for my $stage_set (@$stages) { my ($lstage, $run_by_stage) = @$stage_set; my $search = $search->{$lstage} or next; for my $lcat (@$cat_order) { my $search = $search->{$lcat} or next; for my $ldur (@$dur_order) { my $search = $search->{$ldur} or next; # Make sure anything with conflicts runs early. unless ($SORTED{$search}++) { @$search = sort { scalar(@{$b->{conflicts}}) <=> scalar(@{$a->{conflicts}}) } @$search; } for my $task (@$search) { # If the job has a listed conflict and an existing job is running with that conflict, then pick another job. next if first { $conflicts->{$_} } @{$task->{conflicts}}; my $ok = 1; my @resource_skip; for my $resource (@$resources) { my $out = $resource->available($task) || 0; # normalize false to 0 push @resource_skip => ref($resource) || $resource if $out < 0; $ok &&= $out; # If we have a temporarily unavailable resource we # skip, but if any resource is never avilable # (skip) we want to finish the loop to add them all # for the skip message. last if !$ok && !@resource_skip; } # Some resource is temporarily not available next unless $ok; my $outres = {args => [], env_vars => {}, record => {}}; my @out = ($run_by_stage => $task, $outres); my @record = @$resources; if (@resource_skip) { push @out => (resource_skip => \@resource_skip); # Only the job limiter resources need to be recorded. @record = grep { $_->job_limiter } @record; } for my $resource (@record) { my $res = {args => [], env_vars => {}}; $resource->assign($task, $res); push @{$outres->{args}} => @{$res->{args}}; $outres->{env_vars}->{$_} = $res->{env_vars}->{$_} for keys %{$res->{env_vars}}; $outres->{record}->{ref($resource)} = $res->{record}; } return @out; } } } } } return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::State - State tracking for the runner. =head1 DESCRIPTION This module tracks the state for all running tests. This entire module is considered an "Implementation Detail". Please do not rely on it always staying the same, or even existing in the future. Do not use this directly. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/Run.pm0000644000175000017500000000341615012417054022022 0ustar exodistexodistpackage Test2::Harness::Runner::Run; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use File::Spec(); use Test2::Harness::Util::File::JSONL; use parent 'Test2::Harness::Run'; use Test2::Harness::Util::HashBase qw{ SUPER::init(); croak "'workdir' is a required attribute" unless $self->{+WORKDIR}; } sub run_dir { $_[0]->{+RUN_DIR} //= $_[0]->SUPER::run_dir($_[0]->{+WORKDIR}) } sub jobs_file { $_[0]->{+JOBS_FILE} //= File::Spec->catfile($_[0]->run_dir, 'jobs.jsonl') } sub jobs { $_[0]->{+JOBS} //= Test2::Harness::Util::File::JSONL->new(name => $_[0]->jobs_file, use_write_lock => 1) } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Run - Runner specific subclass of a test run. =head1 DESCRIPTION Runner subclass of L for use inside the runner. =head1 METHODS In addition to the methods provided by L, these are provided. =over 4 =item $dir = $run->workdir Runner directory. =item $dir = $run->run_dir Directory specific to this run. =item $path = $run->jobs_file Path to the C file. =item $fh = $run->jobs Filehandle to C. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner/Job.pm0000644000175000017500000005257215012417054021777 0ustar exodistexodistpackage Test2::Harness::Runner::Job; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/confess croak/; use Config qw/%Config/; use List::Util qw/min/; use Scalar::Util qw/weaken blessed/; use Test2::Util qw/CAN_REALLY_FORK/; use Time::HiRes qw/time/; use File::Spec(); use File::Temp(); use Test2::Harness::Util qw/fqmod clean_path write_file_atomic write_file mod2file open_file parse_exit process_includes chmod_tmp/; use Test2::Harness::IPC; use parent 'Test2::Harness::IPC::Process'; use Test2::Harness::Util::HashBase( qw{ {+RUNNER}; croak "'run' is a required attribute" unless $self->{+RUN}; croak "'settings' is a required attribute" unless $self->{+SETTINGS}; delete $self->{+JOB_DIR}; # Avoid a ref cycle #weaken($self->{+RUNNER}); my $task = $self->{+TASK} or croak "'task' is a required attribute"; delete $self->{+LAST_OUTPUT_SIZE}; confess "Task does not have a job ID" unless $task->{job_id}; confess "Task does not have a file" unless $task->{file}; } sub job_id { $_[0]->{+TASK}->{job_id} } sub prepare_dir { my $self = shift; $self->job_dir(); $self->tmp_dir(); $self->event_dir(); } sub via { my $self = shift; return undef if $self->{+SETTINGS}->debug->dummy; return undef if $self->{+TASK}->{resource_skip}; return $self->{+VIA} if exists $self->{+VIA}; my $task = $self->{+TASK}; return $self->{+VIA} = $task->{via} if $task->{via}; return $self->{+VIA} = $self->{+FORK_CALLBACK} if $self->{+FORK_CALLBACK} && $self->use_fork; return $self->{+VIA} = undef; } sub spawn_params { my $self = shift; my $task = $self->{+TASK}; my $skip; $skip = 'dummy mode' if $self->{+SETTINGS}->debug->dummy; $skip = "Some resources are not available: " . join(', ' => @{$self->{+TASK}->{resource_skip}}) if $self->{+TASK}->{resource_skip}; my $command; if (!$skip && $task->{binary} || $task->{non_perl}) { my $file = $self->ch_dir ? $self->file : $self->rel_file; $file = clean_path($file); $command = [$file, $self->args]; unshift @$command => $^X if $task->{non_perl} && !(-x $file) && !$task->{binary}; } else { $command = [ $^X, $self->cli_includes, $self->{+SETTINGS}->runner->nytprof ? ('-d:NYTProf') : (), $self->switches, $self->cli_options, $skip ? ('-e', "print \"1..0 # SKIP $skip\"") : (sub { $self->run_file }), $self->args, ]; } my $out_fh = open_file($self->out_file, '>'); my $err_fh = open_file($self->err_file, '>'); my $in_fh = open_file($self->in_file, '<'); return { command => $command, stdin => $in_fh, stdout => $out_fh, stderr => $err_fh, chdir => $self->ch_dir(), env => $self->env_vars(), }; } sub switches_from_env { my $self = shift; return @{$self->{+SWITCHES_FROM_ENV}} if $self->{+SWITCHES_FROM_ENV}; return @{$self->{+SWITCHES_FROM_ENV} = []} unless $ENV{HARNESS_PERL_SWITCHES}; return @{$self->{+SWITCHES_FROM_ENV} = [split /\s+/, $ENV{HARNESS_PERL_SWITCHES}]}; } my %JSON_SKIP = ( SETTINGS() => 1, TASK() => 1, RUNNER() => 1, RUN() => 1, CLI_INCLUDES() => 1, CLI_OPTIONS() => 1, ERR_FILE() => 1, ET_FILE() => 1, EVENT_DIR() => 1, EXIT() => 1, EXIT_TIME() => 1, IN_FILE() => 1, JOB_DIR() => 1, LAST_OUTPUT_SIZE() => 1, OUT_FILE() => 1, BAIL_FILE() => 1, OUTPUT_CHANGED() => 1, PET_FILE() => 1, RUN_DIR() => 1, TMP_DIR() => 1, ); sub TO_JSON { my $self = shift; my $out = { %{$self->{+TASK}} }; for my $attr (Test2::Harness::Util::HashBase::attr_list(blessed($self))) { next if $JSON_SKIP{$attr}; $self->$attr unless defined $self->{$attr}; $out->{$attr} = $self->{$attr}; } delete $out->{+FORK_CALLBACK}; delete $out->{+VIA} if ref($out->{+VIA}) eq 'CODE'; $out->{job_name} //= $out->{job_id}; $out->{abs_file} = clean_path($self->file); return $out; } sub run_file { my $self = shift; return $self->{+RUN_FILE} //= $self->rel_file; } sub rel_file { File::Spec->abs2rel($_[0]->file) } sub file { $_[0]->{+FILE} //= clean_path($_[0]->{+TASK}->{file}, 0) } sub err_file { $_[0]->{+ERR_FILE} //= clean_path(File::Spec->catfile($_[0]->job_dir, 'stderr')) } sub out_file { $_[0]->{+OUT_FILE} //= clean_path(File::Spec->catfile($_[0]->job_dir, 'stdout')) } sub bail_file { $_[0]->{+BAIL_FILE} //= clean_path(File::Spec->catfile($_[0]->event_dir, 'bail')) } sub et_file { $_[0]->{+ET_FILE} //= clean_path(File::Spec->catfile($_[0]->job_dir, 'event_timeout')) } sub pet_file { $_[0]->{+PET_FILE} //= clean_path(File::Spec->catfile($_[0]->job_dir, 'post_exit_timeout')) } sub run_dir { $_[0]->{+RUN_DIR} //= clean_path(File::Spec->catdir($_[0]->{+RUNNER}->dir, $_[0]->{+RUN}->run_id)) } sub bailed_out { my $self = shift; if(-f $self->bail_file) { my $fh = open_file($self->bail_file, '<'); my $reason = <$fh> || 1; return $reason; } my $fh = open_file($self->out_file, '<'); while (my $line = <$fh>) { next unless $line =~ m/^Bail out!\s*(.*)$/; return $1 || 1; } return ""; } sub output_size { my $self = shift; my $size = 0; $size += -s $self->err_file || 0; $size += -s $self->out_file || 0; return $self->{+LAST_OUTPUT_SIZE} = $size; } sub output_changed { my $self = shift; my $last = $self->{+LAST_OUTPUT_SIZE}; my $size = $self->output_size(); # Output changed, update time return $self->{+OUTPUT_CHANGED} = time() if $last && $size != $last; # Return the last recorded time, if there is no previously recorded time then the record starts now return $self->{+OUTPUT_CHANGED} //= time(); } sub verbose { $_[0]->{+VERBOSE} //= $_[0]->{+TASK}->{verbose} // 0 } sub is_try { $_[0]->{+IS_TRY} //= $_[0]->{+TASK}->{is_try} // 0 } sub ch_dir { $_[0]->{+CH_DIR} //= $_[0]->{+TASK}->{ch_dir} // '' } sub unsafe_inc { $_[0]->{+UNSAFE_INC} //= $_[0]->{+RUNNER}->unsafe_inc } sub event_uuids { $_[0]->{+EVENT_UUIDS} //= $_[0]->run->event_uuids } sub mem_usage { $_[0]->{+MEM_USAGE} //= $_[0]->run->mem_usage } sub io_events { $_[0]->{+IO_EVENTS} //= $_[0]->_fallback(io_events => 1, qw/task run/) } sub smoke { $_[0]->{+SMOKE} //= $_[0]->_fallback(smoke => 0, qw/task/) } sub retry_isolated { $_[0]->{+RETRY_ISOLATED} //= $_[0]->_fallback(retry_isolated => 0, qw/task run/) } sub use_stream { $_[0]->{+USE_STREAM} //= $_[0]->_fallback(use_stream => 1, qw/task run/) } sub use_timeout { $_[0]->{+USE_TIMEOUT} //= $_[0]->_fallback(use_timeout => 1, qw/task/) } sub retry { $_[0]->{+RETRY} //= $_[0]->_fallback(retry => undef, qw/task run/) } sub event_timeout { $_[0]->{+EVENT_TIMEOUT} //= $_[0]->_fallback(event_timeout => undef, qw/task runner/) } sub post_exit_timeout { $_[0]->{+POST_EXIT_TIMEOUT} //= $_[0]->_fallback(post_exit_timeout => undef, qw/task runner/) } sub min_slots { $_[0]->{+MIN_SLOTS} //= $_[0]->_fallback_non_bool(min_slots => 1, qw/task/) } sub max_slots { $_[0]->{+MAX_SLOTS} //= $_[0]->_fallback_non_bool(max_slots => 1, qw/task/) } sub args { @{$_[0]->{+ARGS} //= $_[0]->_merge_sources(test_args => qw/task run/)} } sub load { @{$_[0]->{+LOAD} //= [@{$_[0]->run->load // []}]} } sub cli_includes { my $self = shift; # '.' is handled via the PERL_USE_UNSAFE_INC env var set later $self->{+CLI_INCLUDES} //= [map { "-I$_" } grep { $_ ne '.' } $self->includes]; return @{$self->{+CLI_INCLUDES}}; } sub runner_includes { @{$_[0]->{+RUNNER_INCLUDES} //= [$_[0]->{+RUNNER}->all_libs]} } sub _merge_sources { my $self = shift; my ($name, @from) = @_; my @vals; for my $from (@from) { my $source = $self->$from; my $val = blessed($source) ? $source->$name : $source->{$name}; next unless defined $val; next unless @$val; push @vals => @$val; } return \@vals; } sub _fallback_non_bool { my $self = shift; my ($name, $default, @from) = @_; for my $from (@from) { my $source = $self->$from; my $val = blessed($source) ? $source->$name : $source->{$name}; return $val if defined $val; } return $default; } sub _fallback { my $self = shift; my ($name, $default, @from) = @_; my @vals; for my $from (@from) { my $source = $self->$from; my $val = blessed($source) ? $source->$name : $source->{$name}; push @vals => $val if defined $val; } return $default unless @vals; # If the default is a ref we will just return the first value we found, truthiness check is useless return shift @vals if ref $default || !defined($default) || $default !~ m/^(0|1)$/; # If the default is true, then we only return true if none of the vals are false return !grep { !$_ } @vals if $default; # If the default is false, then we return true if any of the valse are true return grep { $_ } @vals; } sub job_dir { my $self = shift; return $self->{+JOB_DIR} if $self->{+JOB_DIR}; my $job_dir = File::Spec->catdir($self->run_dir, $self->{+TASK}->{job_id} . '+' . $self->is_try); mkdir($job_dir) or die "$$ $0 Could not create job directory '$job_dir': $!"; chmod_tmp($job_dir); $self->{+JOB_DIR} = $job_dir; } sub tmp_dir { my $self = shift; return $self->{+TMP_DIR} if $self->{+TMP_DIR}; my $tmp_dir = File::Temp::tempdir("XXXXXX", DIR => $self->runner->tmp_dir); chmod_tmp($tmp_dir); $self->{+TMP_DIR} = clean_path($tmp_dir); } sub make_event_dir { $_[0]->event_dir } sub event_dir { my $self = shift; return $self->{+EVENT_DIR} if $self->{+EVENT_DIR}; my $events_dir = File::Spec->catdir($self->job_dir, 'events'); unless (-d $events_dir) { mkdir($events_dir) or die "$$ $0 Could not create events directory '$events_dir': $!"; } $self->{+EVENT_DIR} = $events_dir; } sub in_file { my $self = shift; return $self->{+IN_FILE} if $self->{+IN_FILE}; my $task = $self->{+TASK}; unless ($task->{input}) { my $from_run = $self->run->input_file; return $self->{+IN_FILE} = $from_run if $from_run; } my $stdin = File::Spec->catfile($self->job_dir, 'stdin'); my $content = $task->{input} // $self->run->input // ''; write_file($stdin, $content); return $self->{+IN_FILE} = $stdin; } sub use_fork { my $self = shift; return $self->{+USE_FORK} if defined $self->{+USE_FORK}; my $task = $self->{+TASK}; return $self->{+USE_FORK} = 0 unless CAN_REALLY_FORK; return $self->{+USE_FORK} = 0 if $task->{binary}; return $self->{+USE_FORK} = 0 if $task->{non_perl}; return $self->{+USE_FORK} = 0 if defined($task->{use_fork}) && !$task->{use_fork}; return $self->{+USE_FORK} = 0 if defined($task->{use_preload}) && !$task->{use_preload}; # -w switch is ok, otherwise it is a no-go return $self->{+USE_FORK} = 0 if grep { !m/\s*-w\s*/ } $self->switches; my $runner = $self->{+RUNNER}; return $self->{+USE_FORK} = 0 unless $runner->use_fork; return $self->{+USE_FORK} = 1; } sub includes { my $self = shift; return @{$self->{+INCLUDES}} if $self->{+INCLUDES}; $self->{+INCLUDES} = [ process_includes( list => [$self->runner_includes, @{$self->{+SETTINGS}->harness->orig_inc}], include_dot => $self->unsafe_inc, include_current => 1, clean => 1, $self->ch_dir ? (ch_dir => $self->ch_dir) : (), ) ]; return @{$self->{+INCLUDES}}; } sub cli_options { my $self = shift; my $event_dir = $self->event_dir; my $job_id = $self->job_id; return ( $self->use_stream ? ("-MTest2::Formatter::Stream=dir,$event_dir,job_id,$job_id") : (), $self->event_uuids ? ('-MTest2::Plugin::UUID') : (), $self->mem_usage ? ('-MTest2::Plugin::MemUsage') : (), $self->io_events ? ('-MTest2::Plugin::IOEvents') : (), (map { @{$_->[1]} ? "-M$_->[0]=" . join(',' => @{$_->[1]}) : "-M$_->[0]" } $self->load_import), (map { "-m$_" } $self->load), ); } sub switches { my $self = shift; return @{$self->{+SWITCHES}} if $self->{+SWITCHES}; my @switches; my %seen; for my $s (@{$self->{+TASK}->{switches} // []}) { $seen{$s}++; $self->{+USE_W_SWITCH} = 1 if $s =~ m/\s*-w\s*/; push @switches => $s; } my %seen2; for my $s (@{$self->{+RUNNER}->switches // []}) { next if $seen{$s}; $seen2{$s}++; $self->{+USE_W_SWITCH} = 1 if $s =~ m/\s*-w\s*/; push @switches => $s; } for my $s ($self->switches_from_env) { next if $seen{$s}; next if $seen2{$s}; $self->{+USE_W_SWITCH} = 1 if $s =~ m/\s*-w\s*/; push @switches => $s; } return @{$self->{+SWITCHES} = \@switches}; } sub prof_file { my $self = shift; my $file =$self->rel_file; $file =~ s{/}{-}g; $file =~ s{\.[^\.]+$}{.nytprof}g; return $file; } sub env_vars { my $self = shift; return $self->{+ENV_VARS} if $self->{+ENV_VARS}; my $from_run = $self->run->env_vars; my $from_task = $self->{+TASK}->{env_vars}; my @p5l = ($from_task->{PERL5LIB}, $from_run->{PERL5LIB}); push @p5l => $self->includes if $self->{+TASK}->{binary} || $self->{+TASK}->{non_perl}; push @p5l => $ENV{PERL5LIB} if $ENV{PERL5LIB}; my $p5l = join $Config{path_sep} => grep { defined $_ && $_ ne '.' } @p5l; my $verbose = $self->verbose; return $self->{+ENV_VARS} = { $from_run ? (%$from_run) : (), $from_task ? (%$from_task) : (), $self->use_stream ? (T2_FORMATTER => 'Stream', T2_STREAM_DIR => $self->event_dir, T2_STREAM_JOB_ID => $self->job_id) : (), $self->{+SETTINGS}->runner->nytprof ? (NYTPROF => "addpid=1:start=begin") : (), PERL5LIB => $p5l, PERL_USE_UNSAFE_INC => $self->unsafe_inc, TEST2_JOB_DIR => $self->job_dir, TEST2_RUN_DIR => $self->run_dir, TMPDIR => $self->tmp_dir, TEMPDIR => $self->tmp_dir, SYSTEM_TMPDIR => $self->{+SETTINGS}->harness->orig_tmp, SYSTEM_TMPDIR_PERMS => $self->{+SETTINGS}->harness->orig_tmp_perms, HARNESS_IS_VERBOSE => $verbose, T2_HARNESS_IS_VERBOSE => $verbose, HARNESS_ACTIVE => 1, TEST2_HARNESS_ACTIVE => 1, T2_HARNESS_JOB_FILE => $self->rel_file, T2_HARNESS_JOB_NAME => $self->{+TASK}->{job_name}, T2_HARNESS_JOB_IS_TRY => $self->{+IS_TRY} // 0, T2_HARNESS_JOB_DURATION => $self->{+TASK}->{duration} // '', }; } sub load_import { my $self = shift; return @{$self->{+LOAD_IMPORT}} if $self->{+LOAD_IMPORT}; my $from_run = $self->run->load_import; my @out; for my $mod (@{$from_run->{'@'} // []}) { push @out => [$mod, $from_run->{$mod} // []]; } return @{$self->{+LOAD_IMPORT} = \@out}; } sub use_w_switch { my $self = shift; return $self->{+USE_W_SWITCH} if defined $self->{+USE_W_SWITCH}; $self->switches; return $self->{+USE_W_SWITCH}; } sub set_exit { my $self = shift; my ($runner, $exit, $time, @args) = @_; $self->SUPER::set_exit(@_); my $file = File::Spec->catfile($self->job_dir, 'exit'); my $e = parse_exit($exit); write_file_atomic($file, join(" " => $exit, $e->{err}, $e->{sig}, $e->{dmp}, $time, @args)); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Job - Representation of a test job. =head1 DESCRIPTION This module takes all the data from a test file queue item, a run, and runner settings, and mashes them together to figure out what is actually needed to run a job. =head1 METHODS Note, this object subclasses L. =over 4 =item $arrayref = $job->args Get the arguments for the test either formt he queue item, or from the run. =item $path = $job->bail_file Path to the events-file used in case of a bail-out =item $bool = $job->bailed_out True if the test job bailed out. =item $cat $job->category Process category, always 'job' unless overriden in a subclass. =item $path = $job->ch_dir If this job first requires a change in directory before running, this will return the path. =item @list = $job->cli_includes List of includes for a command line launch of this job. =item @list = $job->cli_options List of options for a command line launch of this job. =item $hashref = $job->env_vars Get environment variables to set when launching this job. =item $path = $job->out_file File to which all STDOUT for the job will be written. =item $path = $job->err_file File to which all STDERR for the job will be written. =item $path = $job->et_file File to which event timeout notifications will be written. =item $path = $job->pet_file File to which post exit timeout events will be written. =item $path = $job->event_dir Directory to which L events will be written. =item $time = $job->event_timeout Event timeout specification, if any, first from test queue item, then from runner. =item $time = $job->post_exit_timeout Post exit timeout specification, if any, first from test queue item, then from runner. =item $bool = $job->event_uuids Use L inside the test. =item $path = $job->file Test file the job will be running. =item $coderef = $job->fork_callback If the job is to be launched via fork, use this callback. =item $path = $job->in_file File containing STDIN to be provided to the test. =item @list = $job->includes Paths to add to @INC for the test. =item $bool = $job->io_events True if L should be used. =item $int = $job->is_try This starts at 0 and will be incremented for every retry of the job. =item $path = $job->job_dir Temporary directory housing all files related to this job when it runs. =item $uuid = $job->job_id UUID for this job. =item @list = $job->load Modules to load when starting this job. =item @list = $job->load_import Modules to load and import when starting this job. =item $bool = $job->mem_usage True if the L plugin should be used. =item $path = $job->run_file Usually the same as rel_file, but you can specify an alternative file to actually run. =item $path = $job->rel_file Relative path to the file. =item $int = $job->retry How many times the test should be retried if it fails. =item $bool = $job->retry_isolated True if the test should be retried in isolation if it fails. =item $run = $job->run The L instance. =item $path = $job->run_dir Path to the temporary directory housing all the data about the run. =item $runner = $job->runner The L instance. =item @list = $job->runner_includes Search path includes provided directly by the runner. =item $settings = $job->settings The L instance. =item $bool = $job->smoke True if the test is a priority smoke test. =item $hashref = $job->spawn_params Parameters for C in L when launching this job. =item @list = $job->switches Command line switches for perl when running this test. =item $hashref = $job->task Task data from the queue. =item $path = $job->tmp_dir Temp dir created specifically for this job. =item $bool = $job->unsafe_inc True if '.' should be added to C<@INC>. =item $bool = $job->use_fork True if this job should be launched via fork. =item $bool = $job->use_stream True if this job should use L. =item $bool = $job->use_timeout True if this job should timeout due to lack of activity. =item $bool = $job->use_w_switch True if the C<-w> switch should be used for this test. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Collector.pm0000644000175000017500000003123515012417054021733 0ustar exodistexodistpackage Test2::Harness::Collector; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use Test2::Harness::Collector::JobDir; use Test2::Harness::Util::UUID qw/gen_uuid/; use Test2::Harness::Util::Queue; use Time::HiRes qw/sleep time/; use File::Spec; use File::Path qw/remove_tree/; use Test2::Harness::Util::HashBase qw{ {+RUN}; my $run_dir = File::Spec->catdir($self->{+WORKDIR}, $self->{+RUN_ID}); die "Could not find run dir" unless -d $run_dir; $self->{+RUN_DIR} = $run_dir; $self->{+WAIT_TIME} //= 0.02; $self->{+ACTION}->($self->_harness_event(0, undef, time, harness_run => $self->{+RUN}, harness_settings => $self->settings, about => {no_display => 1})); } sub process { my $self = shift; my %warning_seen; my $settings = $self->settings; while (1) { my $count = 0; $count += $self->process_runner_output if $self->{+SHOW_RUNNER_OUTPUT}; $count += $self->process_tasks(); my $jobs = $self->jobs; unless (keys %$jobs) { next if $count; if ($self->persistent_runner) { last if $self->{+JOBS_DONE}; last if $self->runner_done; } last if $self->runner_exited; } while(my ($job_try, $jdir) = each %$jobs) { $count++; my $e_count = 0; for my $event ($jdir->poll($self->settings->collector->max_poll_events // 1000)) { $self->{+ACTION}->($event); $e_count++; } $count += $e_count; next if $e_count; my $done = $jdir->done; unless ($done) { $count++; next; } delete $jobs->{$job_try}; unless ($settings->debug->keep_dirs) { my $job_path = $jdir->job_root; # Needed because we set the perms so that a tmpdir under it can be used. # This is the only remove_tree that needs it because it is the # only one in a process that did not initially create the dir. my $ok = eval { chmod(0700, $job_path); remove_tree($job_path, {safe => 1, keep_root => 0}); 1; }; my $err = $@; unless ($ok) { $count++; unless ($warning_seen{$job_path}++) { my $msg = "NON-FATAL Error deleting job dir ($job_path) will try again...: $err"; my $e = $self->_harness_event(0, undef, time, info => [{details => $msg, tag => "INTERNAL", debug => 1, important => 1}]); $self->{+ACTION}->($e); } next; } } delete $jobs->{$job_try}; delete $self->{+PENDING}->{$jdir->job_id} unless $done->{retry}; } last if !$count && $self->runner_exited; sleep $self->{+WAIT_TIME} unless $count; } # One last slurp $self->process_runner_output if $self->{+SHOW_RUNNER_OUTPUT}; $self->{+ACTION}->(undef) if $self->{+JOBS_DONE} && $self->{+TASKS_DONE}; remove_tree($self->{+RUN_DIR}, {safe => 1, keep_root => 0}) unless $settings->debug->keep_dirs; return; } sub runner_done { my $self = shift; return 0 if keys %{$self->{+PENDING}}; return 1; } sub runner_exited { my $self = shift; my $pid = $self->{+RUNNER_PID} or return undef; return $self->{+RUNNER_EXITED} if $self->{+RUNNER_EXITED}; return 0 if kill(0, $pid); return $self->{+RUNNER_EXITED} = 1; } sub process_runner_output { my $self = shift; my $out = 0; return $out unless $self->{+SHOW_RUNNER_OUTPUT}; my $action = $self->{+ACTION}; if ($self->{+TRUNCATE_RUNNER_OUTPUT} && !$self->{+TRUNCATED_RUNNER_OUTPUT}) { $action = sub {}; $self->{+TRUNCATED_RUNNER_OUTPUT} = 1; } my $stdout = $self->{+RUNNER_STDOUT} //= Test2::Harness::Util::File::Stream->new( name => File::Spec->catfile($self->{+WORKDIR}, 'output.log'), ); for my $line ($stdout->poll()) { chomp($line); my $e = $self->_harness_event(0, undef, time, info => [{details => $line, tag => 'INTERNAL', important => 1}]); $action->($e); $out++; } my $stderr = $self->{+RUNNER_STDERR} //= Test2::Harness::Util::File::Stream->new( name => File::Spec->catfile($self->{+WORKDIR}, 'error.log'), ); for my $line ($stderr->poll()) { chomp($line); my $e = $self->_harness_event(0, undef, time, info => [{details => $line, tag => 'INTERNAL', debug => 1, important => 1}]); $action->($e); $out++; } my $auxdir = $self->{+RUNNER_AUX_DIR} //= File::Spec->catdir($self->{+WORKDIR}, 'aux_logs'); return $out unless -d $auxdir; opendir(my $dh, $auxdir) or die "Could not open aux_logs dir: $!"; for my $path (readdir($dh)) { next if $path =~ m/^\.+$/; next if $self->{+RUNNER_AUX_HANDLES}->{$path}; my $tag = uc($path); next unless $tag =~ s/\.LOG$//; my $debug = 0; if ($tag =~ s/\W*(STDERR|STDOUT)\W*//g) { $debug = 1 if $1 && uc($1) eq 'STDERR'; } $self->{+RUNNER_AUX_HANDLES}->{$path} = { tag => $tag, debug => $debug, stream => Test2::Harness::Util::File::Stream->new(name => File::Spec->catfile($auxdir, $path)), }; } for my $file (sort keys %{$self->{+RUNNER_AUX_HANDLES}}) { my $data = $self->{+RUNNER_AUX_HANDLES}->{$file}; my $stream = $data->{stream}; for my $line ($stream->poll()) { chomp($line); my $e = $self->_harness_event(0, undef, time, info => [{details => $line, tag => $data->{tag}, debug => $data->{debug}, important => 1}]); $action->($e); $out++; } } return $out; } sub process_tasks { my $self = shift; return 0 if $self->{+TASKS_DONE}; my $queue = $self->tasks_queue or return 0; my $count = 0; for my $item ($queue->poll) { $count++; my ($spos, $epos, $task) = @$item; unless ($task) { $self->{+TASKS_DONE} = 1; last; } my $job_id = $task->{job_id} or die "No job id!"; $self->{+TASKS}->{$job_id} = $task; $self->{+PENDING}->{$job_id} = 1 + ($task->{retry} || $self->run->retry || 0); my $e = $self->_harness_event($job_id, $task->{is_try} // 0, $task->{stamp}, 'harness_job_queued' => $task); $self->{+ACTION}->($e); } return $count; } sub send_backed_up { my $self = shift; return if $self->{+BACKED_UP}++; # This is an unlikely code path. If we're here, it means the last loop couldn't process any results. my $e = $self->_harness_event(0, undef, time, info => [{details => <<" EOT", tag => "INTERNAL", debug => 1, important => 1}]); *** THIS IS NOT FATAL *** * The collector has reached the maximum number of concurrent jobs to process. * Testing will continue, but some tests may be running or even complete before they are rendered. * All tests and events will eventually be displayed, and your final results will not be effected. Set a higher --max-open-jobs collector setting to prevent this problem in the future, but be advised that could result in too many open filehandles on some systems. This message will only be shown once. EOT $self->{+ACTION}->($e); return; } sub jobs { my $self = shift; my $jobs = $self->{+JOBS} //= {}; return $jobs if $self->{+JOBS_DONE}; # Don't monitor more than 'max_open_jobs' or we might have too many open file handles and crash # Max open files handles on a process applies. Usually this is 1024 so we # can't have everything open at once when we're behind. my $max_open_jobs = $self->settings->collector->max_open_jobs // 1024; my $additional_jobs_to_parse = $max_open_jobs - keys %$jobs; if($additional_jobs_to_parse <= 0) { $self->send_backed_up; return $jobs; } my $queue = $self->jobs_queue or return $jobs; for my $item ($queue->poll($additional_jobs_to_parse)) { my ($spos, $epos, $job) = @$item; unless ($job) { $self->{+JOBS_DONE} = 1; last; } my $job_id = $job->{job_id} or die "No job id!"; die "Found job without a task!" unless $self->{+TASKS}->{$job_id}; $self->{+PENDING}->{$job_id}--; delete $self->{+PENDING}->{$job_id} if $self->{+PENDING}->{$job_id} < 1; my $file = $job->{file}; my $e = $self->_harness_event( $job_id, $job->{is_try}, $job->{stamp}, harness_job => $job, harness_job_start => { details => "Job $job_id started at $job->{stamp}", job_id => $job_id, stamp => $job->{stamp}, file => $file, rel_file => File::Spec->abs2rel($file), abs_file => File::Spec->rel2abs($file), }, harness_job_launch => { stamp => $job->{stamp}, retry => $job->{is_try}, }, ); $self->{+ACTION}->($e); my $job_try = $job_id . '+' . $job->{is_try}; $jobs->{$job_try} = Test2::Harness::Collector::JobDir->new( job_try => $job->{is_try} // 0, job_id => $job_id, run_id => $self->{+RUN_ID}, runner_pid => $self->{+RUNNER_PID}, job_root => File::Spec->catdir($self->{+RUN_DIR}, $job_try), ); } # The collector didn't read in all the jobs because it'd run out of file handles. We need to let the stream know we're behind. $self->send_backed_up if $max_open_jobs <= keys %$jobs; return $jobs; } sub _harness_event { my $self = shift; my ($job_id, $job_try, $stamp, %args) = @_; croak "Job id is required" unless defined $job_id; croak "Stamp is required" unless defined $stamp; return Test2::Harness::Event->new( stamp => $stamp, job_id => $job_id, job_try => $job_try, event_id => gen_uuid(), run_id => $self->{+RUN_ID}, facet_data => \%args, ); } sub jobs_queue { my $self = shift; return $self->{+JOBS_QUEUE} if $self->{+JOBS_QUEUE}; my $jobs_file = $self->{+JOBS_FILE} //= File::Spec->catfile($self->{+RUN_DIR}, 'jobs.jsonl'); return unless -f $jobs_file; return $self->{+JOBS_QUEUE} = Test2::Harness::Util::Queue->new(file => $jobs_file); } sub tasks_queue { my $self = shift; return $self->{+TASK_QUEUE} if $self->{+TASK_QUEUE}; my $tasks_file = $self->{+TASK_FILE} //= File::Spec->catfile($self->{+RUN_DIR}, 'queue.jsonl'); return unless -f $tasks_file; return $self->{+TASK_QUEUE} = Test2::Harness::Util::Queue->new(file => $tasks_file); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Collector - Module that collects test output and provides it as an event stream. =head1 DESCRIPTION This module is responsible for reading and parsing the output produced by multiple jobs running under yath. This module is not intended for external use, it is an implementation detail and can change at any time. Currently instances of this module are not passed to any plugins or callbacks. If you need a collector for a third-party command you should look at L. When a command needs a collector (such as L does) it normally spawns a collector process by execuing C. The C subroutine in L is a good place to look for more details. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Util/0000755000175000017500000000000015012417054020360 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Util/File/0000755000175000017500000000000015012417054021237 5ustar exodistexodistTest2-Harness-1.000158/lib/Test2/Harness/Util/File/Stream.pm0000644000175000017500000000775015012417054023041 0ustar exodistexodistpackage Test2::Harness::Util::File::Stream; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use Test2::Harness::Util qw/lock_file unlock_file/; use Fcntl qw/SEEK_SET/; use parent 'Test2::Harness::Util::File'; use Test2::Harness::Util::HashBase qw/use_write_lock -tail/; sub init { my $self = shift; $self->SUPER::init(); my $tail = $self->{+TAIL} or return; return unless $self->exists; my @lines = $self->poll_with_index; if (@lines < $self->{+TAIL}) { $self->seek(0); } else { $self->seek($lines[0 - $tail]->[0]); } } sub poll_with_index { my $self = shift; my %params = @_; my $max = delete $params{max} || 0; my $pos = $params{from}; $pos = $self->{+LINE_POS} ||= 0 unless defined $pos; my @out; while (!$max || @out < $max) { my ($spos, $epos, $line, $err) = $self->read_line(%params, from => $pos); last unless defined($line) || defined($spos) || defined($epos) || $err; $self->{+LINE_POS} = $epos unless $params{peek} || defined $params{from}; push @out => [$spos, $epos, $line] unless $err; $pos = $epos; } return @out; } sub read { my $self = shift; return $self->poll(from => 0); } sub poll { my $self = shift; my @lines = $self->poll_with_index(@_); return map { $_->[-1] } @lines; } sub write { my $self = shift; my $name = $self->{+NAME}; my $fh; if ($self->{+USE_WRITE_LOCK}) { $fh = lock_file($self->name, '>>'); } else { $fh = Test2::Harness::Util::open_file($self->name, '>>'); } $fh->autoflush(1); seek($fh,2,0); print {$fh} $self->encode($_) for @_; unlock_file($fh) if $self->{+USE_WRITE_LOCK}; close($fh) or die "Could not close file '$name': $!"; return @_; } sub seek { my $self = shift; my ($pos) = @_; my $fh = $self->fh; my $name = $self->{+NAME}; seek($fh, $pos, SEEK_SET) or die "Could not seek to position $pos in file '$name': $!"; $self->{+LINE_POS} = $pos; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::File::Stream - Utility class for manipulating a file that serves as an output stream. =head1 DESCRIPTION Subclass of L that streams the contents of a file, even if the file is still being written. =head1 SYNOPSIS use Test2::Harness::Util::File::Stream; my $stream = Test2::Harness::Util::File::Stream->new(name => 'path/to/file'); # Read some lines my @lines = $stream->poll; ... # Read more lines, if any. push @lines => $stream->poll; =head1 ATTRIBUTES See L for additional attributes. These can be passed in as construction arguments if desired. =over 4 =item $bool = $stream->use_write_lock =item $stream->use_write_lock($bool) Lock the file for every C operation. =item $bool = $stream->tail Start near the end of the file and only poll for updates appended to it. =back =head1 METHODS See L for additional methods. =over 4 =item @lines = $stream->read() Read all lines from the beginning. Every time it is called it returns ALL lines. =item @lines = $stream->poll() =item @lines = $stream->poll(max => $int) Poll for lines. This is an iterator, it should not return the same line more than once, you can call it multiple times to get any additional lines that have been added since the last poll. =item $stream->write(@content) Append @content to the file. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Util/File/JSONL.pm0000644000175000017500000000334615012417054022470 0ustar exodistexodistpackage Test2::Harness::Util::File::JSONL; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use Test2::Harness::Util::JSON qw/encode_json decode_json/; use parent 'Test2::Harness::Util::File::Stream'; use Test2::Harness::Util::HashBase; sub decode { shift; decode_json($_[0]) } sub encode { shift; encode_json(@_) . "\n" } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::File::JSONL - Utility class for a JSONL file (stream) =head1 DESCRIPTION Subclass of L and L which automatically handles encoding/decoding JSONL data. =head1 SYNOPSIS use Test2::Harness::Util::File::JSONL; my $jsonl = Test2::Harness::Util::File::JSONL->new(name => '/path/to/file.jsonl'); while (1) { my @items = $jsonl->poll(max => 1000) or last; for my $item (@items) { ... handle $item ... } } or use Test2::Harness::Util::File::JSONL; my $jsonl = Test2::Harness::Util::File::JSONL->new(name => '/path/to/file.jsonl'); $jsonl->write({my => 'item', ... }); ... =head1 SEE ALSO See the base classes L and L for methods. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Util/File/Value.pm0000644000175000017500000000333715012417054022657 0ustar exodistexodistpackage Test2::Harness::Util::File::Value; use strict; use warnings; our $VERSION = '1.000158'; use parent 'Test2::Harness::Util::File'; use Test2::Harness::Util::HashBase; sub init { my $self = shift; $self->{+DONE} = 1; } sub read { my $self = shift; my $out = $self->SUPER::read(@_); chomp($out) if defined $out; return $out; } sub read_line { my $self = shift; my $out = $self->SUPER::read_line(@_); chomp($out) if defined $out; return $out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::File::Value - Utility class for a file that contains exactly 1 value. =head1 DESCRIPTION This is a subclass of L for files expected to have exactly 1 value stored in them. =head1 SYNOPSIS use Test2::Harness::Util::File::Value; my $vf = Test2::Harness::Util::File::Value->new(name => 'path/to/file'); my $val = $vf->read; =head1 METHODS =over 4 =item $val = $vf->read() Read all contents from the file, C it, and return it. =item $val = $vf->read_line() Read the first line from the file, C it, and return it. Note, this may not return anything if the value in the file does not terminate with a newline. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Util/File/JSON.pm0000644000175000017500000000352015012417054022346 0ustar exodistexodistpackage Test2::Harness::Util::File::JSON; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak confess/; use Test2::Harness::Util::JSON qw/encode_json decode_json encode_pretty_json/; use parent 'Test2::Harness::Util::File'; use Test2::Harness::Util::HashBase qw/pretty/; sub decode { shift; decode_json(@_) } sub encode { shift->pretty ? encode_pretty_json(@_) : encode_json(@_) } sub reset { croak "line reading is disabled for json files" } sub read_line { croak "line reading is disabled for json files" } sub maybe_read { my $self = shift; return undef unless -e $self->{+NAME}; my $out = Test2::Harness::Util::read_file($self->{+NAME}); return undef unless defined($out) && length($out); eval { $out = $self->decode($out); 1 } or confess "$self->{+NAME}: $@"; return $out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::File::JSON - Utility class for a JSON file. =head1 DESCRIPTION Subclass of L which automatically handles encoding/decoding JSON data. =head1 SYNOPSIS require Test2::Harness::Util::File::JSON; my $file = Test2::Harness::Util::File::JSON->new(name => '/path/to/file.json'); $hash = $file->read; # or $$file->write({...}); =head1 SEE ALSO See the base class L for methods. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Util/HashBase.pm0000644000175000017500000003236215012417054022402 0ustar exodistexodistpackage Test2::Harness::Util::HashBase; use strict; use warnings; our $VERSION = '1.000158'; ################################################################# # # # This is a generated file! Do not modify this file directly! # # Use hashbase_inc.pl script to regenerate this file. # # The script is part of the Object::HashBase distribution. # # Note: You can modify the version number above this comment # # if needed, that is fine. # # # ################################################################# { no warnings 'once'; $Test2::Harness::Util::HashBase::HB_VERSION = '0.008'; *Test2::Harness::Util::HashBase::ATTR_SUBS = \%Object::HashBase::ATTR_SUBS; *Test2::Harness::Util::HashBase::ATTR_LIST = \%Object::HashBase::ATTR_LIST; *Test2::Harness::Util::HashBase::VERSION = \%Object::HashBase::VERSION; *Test2::Harness::Util::HashBase::CAN_CACHE = \%Object::HashBase::CAN_CACHE; } require Carp; { no warnings 'once'; $Carp::Internal{+__PACKAGE__} = 1; } BEGIN { # these are not strictly equivalent, but for out use we don't care # about order *_isa = ($] >= 5.010 && require mro) ? \&mro::get_linear_isa : sub { no strict 'refs'; my @packages = ($_[0]); my %seen; for my $package (@packages) { push @packages, grep !$seen{$_}++, @{"$package\::ISA"}; } return \@packages; } } my %SPEC = ( '^' => {reader => 1, writer => 0, dep_writer => 1, read_only => 0, strip => 1}, '-' => {reader => 1, writer => 0, dep_writer => 0, read_only => 1, strip => 1}, '>' => {reader => 0, writer => 1, dep_writer => 0, read_only => 0, strip => 1}, '<' => {reader => 1, writer => 0, dep_writer => 0, read_only => 0, strip => 1}, '+' => {reader => 0, writer => 0, dep_writer => 0, read_only => 0, strip => 1}, ); sub import { my $class = shift; my $into = caller; # Make sure we list the OLDEST version used to create this class. my $ver = $Test2::Harness::Util::HashBase::HB_VERSION || $Test2::Harness::Util::HashBase::VERSION; $Test2::Harness::Util::HashBase::VERSION{$into} = $ver if !$Test2::Harness::Util::HashBase::VERSION{$into} || $Test2::Harness::Util::HashBase::VERSION{$into} > $ver; my $isa = _isa($into); my $attr_list = $Test2::Harness::Util::HashBase::ATTR_LIST{$into} ||= []; my $attr_subs = $Test2::Harness::Util::HashBase::ATTR_SUBS{$into} ||= {}; my %subs = ( ($into->can('new') ? () : (new => \&_new)), (map %{$Test2::Harness::Util::HashBase::ATTR_SUBS{$_} || {}}, @{$isa}[1 .. $#$isa]), ( map { my $p = substr($_, 0, 1); my $x = $_; my $spec = $SPEC{$p} || {reader => 1, writer => 1}; substr($x, 0, 1) = '' if $spec->{strip}; push @$attr_list => $x; my ($sub, $attr) = (uc $x, $x); $attr_subs->{$sub} = sub() { $attr }; my %out = ($sub => $attr_subs->{$sub}); $out{$attr} = sub { $_[0]->{$attr} } if $spec->{reader}; $out{"set_$attr"} = sub { $_[0]->{$attr} = $_[1] } if $spec->{writer}; $out{"set_$attr"} = sub { Carp::croak("'$attr' is read-only") } if $spec->{read_only}; $out{"set_$attr"} = sub { Carp::carp("set_$attr() is deprecated"); $_[0]->{$attr} = $_[1] } if $spec->{dep_writer}; %out; } @_ ), ); no strict 'refs'; *{"$into\::$_"} = $subs{$_} for keys %subs; } sub attr_list { my $class = shift; my $isa = _isa($class); my %seen; my @list = grep { !$seen{$_}++ } map { my @out; if (0.004 > ($Test2::Harness::Util::HashBase::VERSION{$_} || 0)) { Carp::carp("$_ uses an inlined version of Test2::Harness::Util::HashBase too old to support attr_list()"); } else { my $list = $Test2::Harness::Util::HashBase::ATTR_LIST{$_}; @out = $list ? @$list : () } @out; } reverse @$isa; return @list; } sub _new { my $class = shift; my $self; if (@_ == 1) { my $arg = shift; my $type = ref($arg); if ($type eq 'HASH') { $self = bless({%$arg}, $class) } else { Carp::croak("Not sure what to do with '$type' in $class constructor") unless $type eq 'ARRAY'; my %proto; my @attributes = attr_list($class); while (@$arg) { my $val = shift @$arg; my $key = shift @attributes or Carp::croak("Too many arguments for $class constructor"); $proto{$key} = $val; } $self = bless(\%proto, $class); } } else { $self = bless({@_}, $class); } $Test2::Harness::Util::HashBase::CAN_CACHE{$class} = $self->can('init') unless exists $Test2::Harness::Util::HashBase::CAN_CACHE{$class}; $self->init if $Test2::Harness::Util::HashBase::CAN_CACHE{$class}; $self; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::HashBase - Build hash based classes. =head1 SYNOPSIS A class: package My::Class; use strict; use warnings; # Generate 3 accessors use Test2::Harness::Util::HashBase qw/foo -bar ^baz ban +boo/; # Chance to initialize defaults sub init { my $self = shift; # No other args $self->{+FOO} ||= "foo"; $self->{+BAR} ||= "bar"; $self->{+BAZ} ||= "baz"; $self->{+BAT} ||= "bat"; $self->{+BAN} ||= "ban"; $self->{+BOO} ||= "boo"; } sub print { print join ", " => map { $self->{$_} } FOO, BAR, BAZ, BAT, BAN, BOO; } Subclass it package My::Subclass; use strict; use warnings; # Note, you should subclass before loading HashBase. use base 'My::Class'; use Test2::Harness::Util::HashBase qw/bub/; sub init { my $self = shift; # We get the constants from the base class for free. $self->{+FOO} ||= 'SubFoo'; $self->{+BUB} ||= 'bub'; $self->SUPER::init(); } use it: package main; use strict; use warnings; use My::Class; # These are all functionally identical my $one = My::Class->new(foo => 'MyFoo', bar => 'MyBar'); my $two = My::Class->new({foo => 'MyFoo', bar => 'MyBar'}); my $three = My::Class->new(['MyFoo', 'MyBar']); # Readers! my $foo = $one->foo; # 'MyFoo' my $bar = $one->bar; # 'MyBar' my $baz = $one->baz; # Defaulted to: 'baz' my $bat = $one->bat; # Defaulted to: 'bat' # '>ban' means setter only, no reader # '+boo' means no setter or reader, just the BOO constant # Setters! $one->set_foo('A Foo'); #'-bar' means read-only, so the setter will throw an exception (but is defined). $one->set_bar('A bar'); # '^baz' means deprecated setter, this will warn about the setter being # deprecated. $one->set_baz('A Baz'); # '{+FOO} = 'xxx'; =head1 DESCRIPTION This package is used to generate classes based on hashrefs. Using this class will give you a C method, as well as generating accessors you request. Generated accessors will be getters, C setters will also be generated for you. You also get constants for each accessor (all caps) which return the key into the hash for that accessor. Single inheritance is also supported. =head1 THIS IS A BUNDLED COPY OF HASHBASE This is a bundled copy of L. This file was generated using the C script. =head1 METHODS =head2 PROVIDED BY HASH BASE =over 4 =item $it = $class->new(%PAIRS) =item $it = $class->new(\%PAIRS) =item $it = $class->new(\@ORDERED_VALUES) Create a new instance. HashBase will not export C if there is already a C method in your packages inheritance chain. B you just have to declare it before loading L. package My::Package; # predeclare new() so that HashBase does not give us one. sub new; use Test2::Harness::Util::HashBase qw/foo bar baz/; # Now we define our own new method. sub new { ... } This makes it so that HashBase sees that you have your own C method. Alternatively you can define the method before loading HashBase instead of just declaring it, but that scatters your use statements. The most common way to create an object is to pass in key/value pairs where each key is an attribute and each value is what you want assigned to that attribute. No checking is done to verify the attributes or values are valid, you may do that in C if desired. If you would like, you can pass in a hashref instead of pairs. When you do so the hashref will be copied, and the copy will be returned blessed as an object. There is no way to ask HashBase to bless a specific hashref. In some cases an object may only have 1 or 2 attributes, in which case a hashref may be too verbose for your liking. In these cases you can pass in an arrayref with only values. The values will be assigned to attributes in the order the attributes were listed. When there is inheritance involved the attributes from parent classes will come before subclasses. =back =head2 HOOKS =over 4 =item $self->init() This gives you the chance to set some default values to your fields. The only argument is C<$self> with its indexes already set from the constructor. B Test2::Harness::Util::HashBase checks for an init using C<< $class->can('init') >> during construction. It DOES NOT call C on the created object. Also note that the result of the check is cached, it is only ever checked once, the first time an instance of your class is created. This means that adding an C method AFTER the first construction will result in it being ignored. =back =head1 ACCESSORS =head2 READ/WRITE To generate accessors you list them when using the module: use Test2::Harness::Util::HashBase qw/foo/; This will generate the following subs in your namespace: =over 4 =item foo() Getter, used to get the value of the C field. =item set_foo() Setter, used to set the value of the C field. =item FOO() Constant, returns the field C's key into the class hashref. Subclasses will also get this function as a constant, not simply a method, that means it is copied into the subclass namespace. The main reason for using these constants is to help avoid spelling mistakes and similar typos. It will not help you if you forget to prefix the '+' though. =back =head2 READ ONLY use Test2::Harness::Util::HashBase qw/-foo/; =over 4 =item set_foo() Throws an exception telling you the attribute is read-only. This is exported to override any active setters for the attribute in a parent class. =back =head2 DEPRECATED SETTER use Test2::Harness::Util::HashBase qw/^foo/; =over 4 =item set_foo() This will set the value, but it will also warn you that the method is deprecated. =back =head2 NO SETTER use Test2::Harness::Util::HashBase qw/ method is defined at all. =head2 NO READER use Test2::Harness::Util::HashBase qw/>foo/; Only gives you a write (C), no C method is defined at all. =head2 CONSTANT ONLY use Test2::Harness::Util::HashBase qw/+foo/; This does not create any methods for you, it just adds the C constant. =head1 SUBCLASSING You can subclass an existing HashBase class. use base 'Another::HashBase::Class'; use Test2::Harness::Util::HashBase qw/foo bar baz/; The base class is added to C<@ISA> for you, and all constants from base classes are added to subclasses automatically. =head1 GETTING A LIST OF ATTRIBUTES FOR A CLASS Test2::Harness::Util::HashBase provides a function for retrieving a list of attributes for an Test2::Harness::Util::HashBase class. =over 4 =item @list = Test2::Harness::Util::HashBase::attr_list($class) =item @list = $class->Test2::Harness::Util::HashBase::attr_list() Either form above will work. This will return a list of attributes defined on the object. This list is returned in the attribute definition order, parent class attributes are listed before subclass attributes. Duplicate attributes will be removed before the list is returned. B This list is used in the C<< $class->new(\@ARRAY) >> constructor to determine the attribute to which each value will be paired. =back =head1 SOURCE The source code repository for HashBase can be found at F. =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 2017 Chad Granum Eexodist@cpan.orgE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut Test2-Harness-1.000158/lib/Test2/Harness/Util/Queue.pm0000644000175000017500000000711015012417054022001 0ustar exodistexodistpackage Test2::Harness::Util::Queue; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use Time::HiRes qw/time/; use Test2::Harness::Util qw/write_file_atomic/; use Test2::Harness::Util::File::JSONL(); use Test2::Harness::Util::HashBase qw{ -file -qh -ended }; sub init { my $self = shift; croak "'file' is a required attribute" unless $self->{+FILE}; } sub start { my $self = shift; write_file_atomic($self->{+FILE}, ""); } sub seek { my $self = shift; my ($pos) = @_; $self->{+QH} ||= Test2::Harness::Util::File::JSONL->new(name => $self->{+FILE}); $self->{+QH}->seek($pos); return $pos; } sub reset { my $self = shift; delete $self->{+QH}; } sub poll { my $self = shift; my $max = shift; return $self->{+ENDED} if $self->{+ENDED}; $self->{+QH} ||= Test2::Harness::Util::File::JSONL->new(name => $self->{+FILE}); my @out = $self->{+QH}->poll_with_index( $max ? (max => $max) : () ); $self->{+ENDED} = $out[-1] if @out && !defined($out[-1]->[-1]); return @out; } sub end { my $self = shift; $self->_enqueue(undef); } sub enqueue { my $self = shift; my ($task) = @_; croak "Invalid task" unless $task && ref($task) eq 'HASH' && values %$task; $task->{stamp} ||= time; $self->_enqueue($task); } sub _enqueue { my $self = shift; my ($task) = @_; my $fh = Test2::Harness::Util::File::JSONL->new(name => $self->{+FILE}, use_write_lock => 1); $fh->write($task); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::Queue - Representation of a queue. =head1 DESCRIPTION This module represents a queue, stored as a jsonl file. =head1 SYNOPSIS use Test2::Harness::Util::Queue; my $queue = Test2::Harness::Util::Queue->new(file => '/path/to/queue.jsonl'); $queue->start(); # Create the queue $queue->enqueue({foo => 'bar', baz => 'bat'}); $queue->enqueue({foo => 'bar2', baz => 'bat2'}); ... $queue->end(); Then in another processs: use Test2::Harness::Util::Queue; my $queue = Test2::Harness::Util::Queue->new(file => '/path/to/queue.jsonl'); my @items; while (1) { @items = $queue->poll(); while (@items) { my $item = shift @items or last; ... process $item } # Queue ends with an 'undef' entry last if @items && !defined($items[0]); } =head1 METHODS =over 4 =item $path = $queue->file The filename used for the queue =back =head2 READING =over 4 =item $queue->reset() Restart reading the queue. =item @items = $queue->poll() Get more items from the queue. May need to call it multiple times, specially if another process is still writing to the queue. Returns an empty list if no items are available yet. Returns 'undef' to terminate the list. =item $bool = $queue->ended() Check if the queue has ended. =back =head1 WRITING =over 4 =item $queue->start() Open the queue file for writing. =item $queue->enqueue(\%HASHREF) Add an item to the queue. =item $queue->end() Terminate the queue. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Util/JSON.pm0000644000175000017500000001431215012417054021470 0ustar exodistexodistpackage Test2::Harness::Util::JSON; use strict; use warnings; use Carp qw/croak/; our $VERSION = '1.000158'; BEGIN { local $@ = undef; my $ok = eval { require JSON::MaybeXS; JSON::MaybeXS->import('JSON'); 1; if (JSON() eq 'JSON::PP') { *JSON_IS_PP = sub() { 1 }; *JSON_IS_XS = sub() { 0 }; *JSON_IS_CPANEL = sub() { 0 }; *JSON_IS_CPANEL_OR_XS = sub() { 0 }; } elsif (JSON() eq 'JSON::XS') { *JSON_IS_PP = sub() { 0 }; *JSON_IS_XS = sub() { 1 }; *JSON_IS_CPANEL = sub() { 0 }; *JSON_IS_CPANEL_OR_XS = sub() { 1 }; } elsif (JSON() eq 'Cpanel::JSON::XS') { *JSON_IS_PP = sub() { 0 }; *JSON_IS_XS = sub() { 0 }; *JSON_IS_CPANEL = sub() { 1 }; *JSON_IS_CPANEL_OR_XS = sub() { 1 }; } }; unless ($ok) { require JSON::PP; *JSON = sub() { 'JSON::PP' }; *JSON_IS_PP = sub() { 1 }; *JSON_IS_XS = sub() { 0 }; *JSON_IS_CPANEL = sub() { 0 }; *JSON_IS_CPANEL_OR_XS = sub() { 0 }; } } our @EXPORT = qw{JSON encode_json decode_json encode_pretty_json encode_canon_json stream_json_l stream_json_l_file stream_json_l_url}; our @EXPORT_OK = qw{JSON_IS_PP JSON_IS_XS JSON_IS_CPANEL JSON_IS_CPANEL_OR_XS}; BEGIN { require Exporter; our @ISA = qw(Exporter) } my $json = JSON->new->utf8(1)->convert_blessed(1)->allow_nonref(1); my $json_non_utf8 = JSON->new->utf8(0)->convert_blessed(1)->allow_nonref(1); my $canon = JSON->new->utf8(1)->canonical(1)->convert_blessed(1)->allow_nonref(1); my $pretty = JSON->new->utf8(1)->pretty(1)->canonical(1)->convert_blessed(1)->allow_nonref(1); sub encode_json { $json->encode(@_) } sub encode_canon_json { $canon->encode(@_) } sub encode_pretty_json { $pretty->encode(@_) } sub decode_json { my ($input) = @_; my $data; local $@; my $error; # Try to decode the JSON stream as utf8. In malformed tests or tests which are intentionally # testing bytes behavior we need to accept the bytes from the JSON file instead. my $ok = eval { $data = $json->decode($input); 1 } || do { $error = $@; eval { $data = $json_non_utf8->decode($input); 1 }; }; $error ||= $@; return $data if $ok; my $mess = Carp::longmess("JSON decode error: $error"); die "$mess\n=======\n$input\n=======\n"; } sub stream_json_l { my ($path, $handler, %params) = @_; croak "No path provided" unless $path; return stream_json_l_file($path, $handler) if -f $path; return stream_json_l_url($path, $handler, %params) if $path =~ m{^https?://}; croak "'$path' is not a valid path (file does not exist, or is not an http(s) url)"; } sub stream_json_l_file { my ($path, $handler) = @_; croak "Invalid file '$path'" unless -f $path; croak "Path must have a .json or .jsonl extension with optional .gz or .bz2 postfix." unless $path =~ m/\.(json(?:l)?)(?:.(?:bz2|gz))?$/; if ($1 eq 'json') { require Test2::Harness::Util::File::JSON; my $json = Test2::Harness::Util::File::JSON->new(name => $path); $handler->($json->read); } else { require Test2::Harness::Util::File::JSONL; my $jsonl = Test2::Harness::Util::File::JSONL->new(name => $path); while (my ($item) = $jsonl->poll(max => 1)) { $handler->($item); } } return 1; } sub stream_json_l_url { my ($path, $handler, %params) = @_; my $meth = $params{http_method} // 'get'; my $args = $params{http_args} // []; require HTTP::Tiny; my $ht = HTTP::Tiny->new(); my $buffer = ''; my $iterate = sub { my ($res) = @_; my @parts = split /(\n)/, $buffer; while (@parts > 1) { my $line = shift @parts; my $nl = shift @parts; my $data; unless (eval { $data = decode_json($line); 1 }) { warn "Unable to decode json for chunk when parsing json/l chunk:\n----\n$line\n----\n$@\n----\n"; next; } $handler->($data, $res); } $buffer = shift @parts // ''; }; my $res = $ht->$meth( $path, { @$args, data_callback => sub { my ($chunk, $res) = @_; $buffer .= $chunk; $iterate->($res); }, } ); if (length($buffer)) { $buffer .= "\n" unless $buffer =~ m/\n$/; $iterate->($res); } return $res; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::JSON - Utility class to help Test2::Harness pick the best JSON implementation. =head1 DESCRIPTION This package provides functions for encoding/decoding json, and uses the best json tools available. =head1 SYNOPSIS use Test2::Harness::Util::JSON qw/encode_json decode_json/; my $data = { foo => 1 }; my $json = encode_json($data); my $copy = decode_json($json); =head1 EXPORTS =over 4 =item $package = JSON() This returns the JSON package being used by yath. =item $bool = JSON_IS_PP() True if yath is using L. =item $bool = JSON_IS_XS() True if yath is using L. =item $bool = JSON_IS_CPANEL() True if yath is using L. =item $bool = JSON_IS_CPANEL_OR_XS() True if either L or L are being used. =item $string = encode_json($data) Encode data into json. String will be 1-line. =item $data = decode_json($string) Decode json data from the string. =item $string = encode_pretty_json($data) Encode into human-friendly json. =item $string = encode_canon_json($data) Encode into canon-json. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Util/UUID.pm0000644000175000017500000000235715012417054021473 0ustar exodistexodistpackage Test2::Harness::Util::UUID; use strict; use warnings; our $VERSION = '1.000158'; use Data::UUID; use Importer 'Importer' => 'import'; our @EXPORT = qw/gen_uuid/; our @EXPORT_OK = qw/UG gen_uuid/; my ($UG, $UG_PID); sub UG { return $UG if $UG && $UG_PID && $UG_PID == $$; $UG_PID = $$; return $UG = Data::UUID->new; } sub gen_uuid { UG()->create_str() } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::UUID - Utils for generating UUIDs. =head1 DESCRIPTION This module provides a consistent UUID source for all of Test2::Harness. =head1 SYNOPSIS use Test2::Harness::Util::UUID qw/gen_uuid/; my $uuid = gen_uuid; =head1 EXPORTS =over 4 =item $uuid = gen_uuid() Generate a UUID. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Util/Term.pm0000644000175000017500000000320215012417054021622 0ustar exodistexodistpackage Test2::Harness::Util::Term; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Util qw/IS_WIN32/; use Importer Importer => 'import'; our @EXPORT_OK = qw/USE_ANSI_COLOR/; { my $use = 0; local ($@, $!); if (eval { require Term::ANSIColor; Term::ANSIColor->VERSION('4.03') }) { if (IS_WIN32) { if (eval { require Win32::Console::ANSI }) { Win32::Console::ANSI->import(); $use = 1; } } else { $use = 1; } } if ($use) { *USE_ANSI_COLOR = sub() { 1 }; } else { *USE_ANSI_COLOR = sub() { 0 }; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::Term - Terminal utilities for Test2::Harness =head1 DESCRIPTION This module provides information about the terminal in which the harness is running. =head1 SYNOPSIS use Test2::Harness::Util::Term qw/USE_ANSI_COLOR/; if (USE_ANSI_COLOR) { ... } else { ... } =head1 EXPORTS =over 4 =item $bool = USE_ANSI_COLOR() True if L is available and usable. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Util/File.pm0000644000175000017500000001325415012417054021602 0ustar exodistexodistpackage Test2::Harness::Util::File; use strict; use warnings; our $VERSION = '1.000158'; use IO::Handle; use Test2::Harness::Util(); use Carp qw/croak confess/; use Fcntl qw/SEEK_SET SEEK_CUR/; use Test2::Harness::Util::HashBase qw{ -name -_fh -_init_fh done -line_pos {+NAME} } sub decode { shift; $_[0] } sub encode { shift; $_[0] } sub init { my $self = shift; croak "'name' is a required attribute" unless $self->{+NAME}; $self->{+_INIT_FH} = delete $self->{fh}; } sub open_file { my $self = shift; return Test2::Harness::Util::open_file($self->{+NAME}, @_) } sub maybe_read { my $self = shift; return undef unless -e $self->{+NAME}; return $self->read; } sub read { my $self = shift; my $out = Test2::Harness::Util::read_file($self->{+NAME}); eval { $out = $self->decode($out); 1 } or confess "$self->{+NAME}: $@"; return $out; } sub rewrite { my $self = shift; return Test2::Harness::Util::write_file($self->{+NAME}, $self->encode(@_)); } sub write { my $self = shift; return Test2::Harness::Util::write_file_atomic($self->{+NAME}, $self->encode(@_)); } sub reset { my $self = shift; delete $self->{+_FH}; delete $self->{+DONE}; delete $self->{+LINE_POS}; return; } sub fh { my $self = shift; return $self->{+_FH}->{$$} if $self->{+_FH}->{$$}; # Remove any other PID handles $self->{+_FH} = {}; if (my $fh = $self->{+_INIT_FH}) { $self->{+_FH}->{$$} = $fh; } else { $self->{+_FH}->{$$} = Test2::Harness::Util::maybe_open_file($self->{+NAME}) or return undef; } $self->{+_FH}->{$$}->blocking(0); return $self->{+_FH}->{$$}; } sub read_line { my $self = shift; my %params = @_; my $pos = $params{from}; $pos = $self->{+LINE_POS} ||= 0 unless defined $pos; my $fh = $self->{+_FH}->{$$} || $self->fh or return undef; seek($fh,$pos,SEEK_SET) or die "Could not seek: $!" if eof($fh) || tell($fh) != $pos; my $line = <$fh>; # No line, nothing to do return unless defined $line && length($line); # Partial line, hold off unless done return unless $self->{+DONE} || substr($line, -1, 1) eq "\n"; my $new_pos = tell($fh); die "Failed to 'tell': $!" if $new_pos == -1; my $err = 0; local $@; unless (eval { $line = $self->decode($line); 1 }) { $err = $@ // 'error'; confess "$self->{+NAME} ($pos -> $new_pos): $err" unless $self->{+SKIP_BAD_DECODE}; warn "Skipping line that failed to decode: $err\n" if $self->{+SKIP_BAD_DECODE} > 1; $line = undef; } $self->{+LINE_POS} = $new_pos unless defined $params{peek} || defined $params{from}; return $line unless wantarray; return ($pos, $new_pos, $line, $err); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::File - Utility class for manipulating a file. =head1 DESCRIPTION This is a utility class for file operations. This also serves as a base class for several file helpers. =head1 SYNOPSIS use Test2::Harness::Util::File; my $f = Test2::Harness::Util::File->new(name => '/path/to/file'); $f->write($content); my $fh = $f->open_file('<'); # Read, throw exception if it cannot read my $content = $f->read(); # Try to read, but do not throw an exception if it cannot be read. my $content_or_undef = $f->maybe_read(); my $line1 = $f->read_line(); my $line2 = $f->read_line(); ... =head1 ATTRIBUTES =over 4 =item $filename = $f->name; Get the filename. Must also be provided during construction. =item $bool = $f->done; True if read_line() has read every line. =back =head1 METHODS =over 4 =item $decoded = $f->decode($encoded) This is a no-op, it returns the argument unchanged. This is called by C and C. Subclasses can override this if the file contains encoded data. =item $encoded = $f->encode($decoded) This is a no-op, it returns the argument unchanged. This is called by C. Subclasses can override this if the file contains encoded data. =item $bool = $f->exists() Check if the file exists =item $content = $f->maybe_read() This will read the file if it can and return the content (all lines joined together as a single string). If the file cannot be read, or does not exist this will return undef. =item $fh = $f->open_file() =item $fh = $f->open_file($mode) Open a handle to the file. If no $mode is provided C<< '<' >> is used. =item $content = $f->read() This will read the file if it can and return the content (all lines joined together as a single string). If the file cannot be read, or does not exist this will throw an exception. =item $line = $f->read_line() Read a single line from the file, subsequent calls will read the next line and so on until the end of the file is reached. Reset with the C method. =item $f->reset() Reset the internal line iterator used by C. =item $f->write($content) This is an atomic-write. First $content will be written to a temporary file using C<< '>' >> mode. Then the temporary file will be renamed to the desired file name. Under the hood this uses C from L. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Util/IPC.pm0000644000175000017500000002116715012417054021340 0ustar exodistexodistpackage Test2::Harness::Util::IPC; use strict; use warnings; our $VERSION = '1.000158'; use Cwd qw/getcwd/; use Config qw/%Config/; use Test2::Util qw/CAN_REALLY_FORK/; use Importer Importer => 'import'; our @EXPORT_OK = qw{ USE_P_GROUPS run_cmd swap_io }; BEGIN { if ($Config{'d_setpgrp'}) { *USE_P_GROUPS = sub() { 1 }; } else { *USE_P_GROUPS = sub() { 0 }; } } if (CAN_REALLY_FORK) { *run_cmd = \&_run_cmd_fork; } else { *run_cmd = \&_run_cmd_spwn; } sub swap_io { my ($fh, $to, $die, $mode) = @_; $die ||= sub { my @caller = caller; my @caller2 = caller(1); die("$_[0] at $caller[1] line $caller[2] ($caller2[1] line $caller2[2], ${ \__FILE__ } line ${ \__LINE__ }).\n"); }; my $orig_fd; if (ref($fh) eq 'ARRAY') { ($orig_fd, $fh) = @$fh; } else { $orig_fd = fileno($fh); } $die->("Could not get original fd ($fh)") unless defined $orig_fd; if (ref($to)) { $mode //= $orig_fd ? '>&' : '<&'; open($fh, $mode, $to) or $die->("Could not redirect output: $!"); } else { $mode //= $orig_fd ? '>' : '<'; open($fh, $mode, $to) or $die->("Could not redirect output to '$to': $!"); } return if fileno($fh) == $orig_fd; $die->("New handle does not have the desired fd!"); } sub _run_cmd_fork { my %params = @_; my $cmd = $params{command} or die "No 'command' specified"; my $pid = fork; die "Failed to fork" unless defined $pid; if ($pid) { $_->() for @{$params{run_in_parent} // []}; return $pid; } else { $_->() for @{$params{run_in_child} // []}; } %ENV = (%ENV, %{$params{env}}) if $params{env}; setpgrp(0, 0) if USE_P_GROUPS && !$params{no_set_pgrp}; $cmd = [$cmd->()] if ref($cmd) eq 'CODE'; if (my $dir = $params{chdir} // $params{ch_dir}) { chdir($dir) or die "Could not chdir: $!"; } my $stdout = $params{stdout}; my $stderr = $params{stderr}; my $stdin = $params{stdin}; open(my $OLD_STDERR, '>&', \*STDERR) or die "Could not clone STDERR: $!"; my $die = sub { my $caller1 = $params{caller1}; my $caller2 = $params{caller2}; my $msg = "$_[0] at $caller1->[1] line $caller1->[2] ($caller2->[1] line $caller2->[2]).\n"; print $OLD_STDERR $msg; print STDERR $msg; POSIX::_exit(127); }; swap_io(\*STDERR, $stderr, $die) if $stderr; swap_io(\*STDOUT, $stdout, $die) if $stdout; swap_io(\*STDIN, $stdin, $die) if $stdin; open(STDIN, "<", "/dev/null") if !$stdin; @$cmd = map { ref($_) eq 'CODE' ? $_->() : $_ } @$cmd; exec(@$cmd) or $die->("Failed to exec!"); } sub _run_cmd_spwn { my %params = @_; local %ENV = (%ENV, %{$params{env}}) if $params{env}; my $cmd = $params{command} or die "No 'command' specified"; $cmd = [$cmd->()] if ref($cmd) eq 'CODE'; my $cwd; if (my $dir = $params{chdir} // $params{ch_dir}) { $cwd = getcwd(); chdir($dir) or die "Could not chdir: $!"; } my $stdout = $params{stdout}; my $stderr = $params{stderr}; my $stdin = $params{stdin}; open(my $OLD_STDIN, '<&', \*STDIN) or die "Could not clone STDIN: $!"; open(my $OLD_STDOUT, '>&', \*STDOUT) or die "Could not clone STDOUT: $!"; open(my $OLD_STDERR, '>&', \*STDERR) or die "Could not clone STDERR: $!"; my $die = sub { my $caller1 = $params{caller1}; my $caller2 = $params{caller2}; my $msg = "$_[0] at $caller1->[1] line $caller1->[2] ($caller2->[1] line $caller2->[2], ${ \__FILE__ } line ${ \__LINE__ }).\n"; print $OLD_STDERR $msg; print STDERR $msg; POSIX::_exit(127); }; swap_io(\*STDIN, $stdin, $die) if $stdin; swap_io(\*STDOUT, $stdout, $die) if $stdout; $stdin ? swap_io(\*STDIN, $stdin, $die) : close(STDIN); local $?; my $pid; my $ok = eval { $pid = system 1, map { ref($_) eq 'CODE' ? $_->() : $_ } @$cmd }; my $bad = $?; my $err = $@; swap_io($stdin ? \*STDIN : [0, \*STDIN], $OLD_STDIN, $die); swap_io(\*STDERR, $OLD_STDERR, $die) if $stderr; swap_io(\*STDOUT, $OLD_STDOUT, $die) if $stdout; if ($cwd) { chdir($cwd) or die "Could not chdir: $!"; } die $err unless $ok; die "Spawn resulted in code $bad" if $bad && $bad != $pid; die "Failed to spawn" unless $pid; $_->() for @{$params{run_in_parent} // []}; return $pid; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::IPC - Utilities for IPC management. =head1 DESCRIPTION This package provides low-level IPC tools for Test2::Harness. =head1 EXPORTS All exports are optional and must be specified at import time. =over 4 =item $bool = USE_P_GROUPS() This is a shortcut for: use Config qw/%Config/; $Config{'d_setpgrp'}; =item swap_io($from, $to) =item swap_io($from, $to, \&die) This will close and re-open the file handle designated by C<$from> so that it redirects to the handle specified in C<$to>. It preserves the file descriptor in the process, and throws an exception if it fails to do so. swap_io(\*STDOUT, $fh); # STDOUT now points to wherever $fh did, but maintains the file descriptor number '2'. As long as the file descriptor is greater than 0 it will open for writing. If the descriptor is 0 it will open for reading, allowing for a swap of C as well. Extra effort is made to insure errors go to the real C, specially when trying to swap out C. If you have trouble with this, or do not trust it, you can provide a custom coderef as a third argument, this coderef will be used instead of C to throw exceptions. Note that the custom die logic when you do not provide your own bypasses the exception catching mechanism and will exit your program. If this is not desirable then you should provide a custom die subref. =item $pid = run_cmd(command => [...], %params) This function will run the specified command and return a pid to you. When possible this will be done via C and C. When that is not possible it uses the C trick to spawn a new process. Some parameters do not work in the second case, and are silently ignored. Parameters: =over 4 =item command => [$command, sub { ... }, @args] =item command => sub { return ($command, @args) } This parameter is required. This should either be an arrayref of arguments for C, or a coderef that returns a list of arguments for C. On systems without fork/exec the arguments will be passed to C instead. If the command arrayref has a coderef in it, the coderef will be run and its return value(s) will be inserted in its place. This replacement happens post-chroot =item run_in_parent => [sub { ... }, sub { ... }] An arrayref of callbacks to be run in the parent process immedietly after the child process is started. =item run_in_child => [sub { ... }, sub { ... }] An arrayref of callbacks to be run in the child process immedietly after fork. This parameter is silently ignored on systems without fork/exec. =item env => { ENVVAR => $VAL, ... } A hashref of custom environment variables to set in the child process. In the fork/exec model this is done post-fork, in the spawn model this is done via local prior to the spawn. =item no_set_pgrp => $bool, Normall C is called on systems where it is supported. You can use this parameter to override the normal behavior. setpgrp() is not called in the spawn model, so this parameter is silently ignored there. =item chdir => 'path/to/dir' =item ch_dir => 'path/to/dir' chdir() to the specified directory for the new process. In the fork/exec model this is done post-fork in the child. In the spawn model this is done before the spawn, then a second chdir() puts the parent process back to its original dir after the spawn. =item stdout => $handle =item stderr => $handle =item stdin => $handle Thise can be used to provide custom STDERR, STDOUT, and STDIN. In the fork/exec model these are swapped into place post-fork in the child. In the spawn model the swap occurs pre-spawn, then the old handles are swapped back post-spawn. =back =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Renderer.pm0000644000175000017500000000577715012417054021567 0ustar exodistexodistpackage Test2::Harness::Renderer; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use Test2::Harness::Util::HashBase qw/-settings -verbose -progress -color -command_class/; sub render_event { croak "$_[0] forgot to override 'render_event()'" } sub step {} sub finish { } sub signal { } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Renderer - Base class for Test2::Harness event renderers. =head1 DESCRIPTION =head1 ATTRIBUTES These are set at construction time and cannot be changed. =over 4 =item $settings = $renderer->settings Get the L reference. =item $int = $renderer->verbose Get the verbosity level. =item $bool = $renderer->progress True if progress indicators should be shown. =item $bool = $renderer->color True if color should be used. =back =head1 METHODS =over 4 =item $renderer->render_event($event) Called for every event. Return is ignored. =item $renderer->finish(%ARGS) Called once after testing is done. C<%ARGS>: =item $renderer->signal($signal) Called when the rendering process receives a signal. This is your chance to do any cleanup or report the signal. This is not an event, you can ignore it. Do not exit or throw any exceptions here please. =over 4 =item settings => $settings Get the L reference. =item pass => $bool True if tests passed. =item tests_seen => $int Number of test files seen. =item asserts_seen => $int Number of assertions made. =item final_data => $final_data The final_data looks like this, note that some data may not be present if it is not applicable. The data structure can be as simple as C<< { pass => $bool } >>. { pass => $pass, # boolean, did the test run pass or fail? failed => [ # Jobs that failed, and did not pass on a retry [$job_id1, $file1], # Failing job 1 [$job_id2, $file2], # Failing job 2 ... ], retried => [ # Jobs that failed and were retried [$job_id1, $times_run1, $file1, $passed_eventually1], # Passed_eventually is a boolean [$job_id2, $times_run2, $file2, $passed_eventually2], ... ], hatled => [ # Jobs that caused the entire test suite to halt [$job_id1, $file1, $halt_reason1], # halt_reason is a human readible string [$job_id2, $file2, $halt_reason2], ], } =back =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/TestFile.pm0000644000175000017500000004357615012417054021537 0ustar exodistexodistpackage Test2::Harness::TestFile; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use Time::HiRes qw/time/; use List::Util 1.45 qw/uniq/; use Test2::Harness::Util qw/open_file clean_path/; use Test2::Harness::Util::UUID qw/gen_uuid/; use File::Spec; use Test2::Harness::Util::HashBase qw{ set__duration(lc($_[1])) } sub set_category { $_[0]->set__category(lc($_[1])) } sub set_stage { $_[0]->set__stage($_[1]) } sub set_min_slots { $_[0]->set__min_slots($_[1]) } sub set_max_slots { $_[0]->set__max_slots($_[1]) } sub retry { $_[0]->headers->{retry} } sub set_retry { my $self = shift; my $val = @_ ? $_[0] : 1; $self->scan; $self->{+_HEADERS}->{retry} = $val; } sub retry_isolated { $_[0]->headers->{retry_isolated} } sub set_retry_isolated { my $self = shift; my $val = @_ ? $_[0] : 1; $self->scan; $self->{+_HEADERS}->{retry_isolated} = $val; } sub set_smoke { my $self = shift; my $val = @_ ? $_[0] : 1; $self->scan; $self->{+_HEADERS}->{features}->{smoke} = $val; } sub init { my $self = shift; my $file = $self->file; # We want absolute path $file = clean_path($file, 0); $self->{+FILE} = $file; $self->{+QUEUE_ARGS} ||= []; croak "Invalid test file '$file'" unless -f $file; if($self->{+IS_BINARY} = -B $file && !-z $file) { $self->{+NON_PERL} = 1; die "Cannot run binary test file '$file': file is not executable.\n" unless $self->is_executable; } } sub relative { my $self = shift; return $self->{+RELATIVE} //= File::Spec->abs2rel($self->{+FILE}); } my %DEFAULTS = ( timeout => 1, fork => 1, preload => 1, stream => 1, run => 1, isolation => 0, smoke => 0, io_events => 1, ); sub check_feature { my $self = shift; my ($feature, $default) = @_; $default = $DEFAULTS{$feature} unless defined $default; return $default unless defined $self->headers->{features}->{$feature}; return 1 if $self->headers->{features}->{$feature}; return 0; } sub check_stage { my $self = shift; return $self->{+_STAGE} if $self->{+_STAGE}; $self->_scan unless $self->{+_SCANNED}; return $self->{+_HEADERS}->{stage} || undef; } sub check_min_slots { my $self = shift; return $self->{+_MIN_SLOTS} if $self->{+_MIN_SLOTS}; $self->_scan unless $self->{+_SCANNED}; return $self->{+_HEADERS}->{min_slots} // undef; } sub check_max_slots { my $self = shift; return $self->{+_MAX_SLOTS} if $self->{+_MAX_SLOTS}; $self->_scan unless $self->{+_SCANNED}; return $self->{+_HEADERS}->{max_slots} // undef; } sub meta { my $self = shift; my ($key) = @_; $self->_scan unless $self->{+_SCANNED}; my $meta = $self->{+_HEADERS}->{meta} or return (); return () unless $key && $meta->{$key}; return @{$meta->{$key}}; } sub check_duration { my $self = shift; return $self->{+_DURATION} if $self->{+_DURATION}; $self->_scan unless $self->{+_SCANNED}; my $duration = $self->{+_HEADERS}->{duration}; return $duration if $duration; my $timeout = $self->check_feature(timeout => 1); # 'long' for anything with no timeout return 'long' unless $timeout; return 'medium'; } sub check_category { my $self = shift; return $self->{+_CATEGORY} if $self->{+_CATEGORY}; $self->_scan unless $self->{+_SCANNED}; my $category = $self->{+_HEADERS}->{category}; return $category if $category; my $isolate = $self->check_feature(isolation => 0); # 'isolation' queue if isolation requested return 'isolation' if $isolate; return 'general'; } sub event_timeout { $_[0]->headers->{timeout}->{event} } sub post_exit_timeout { $_[0]->headers->{timeout}->{postexit} } sub conflicts_list { return $_[0]->headers->{conflicts} || []; # Assure conflicts is always an array ref. } sub headers { my $self = shift; $self->_scan unless $self->{+_SCANNED}; return {} unless $self->{+_HEADERS}; return {%{$self->{+_HEADERS}}}; } sub shbang { my $self = shift; $self->_scan unless $self->{+_SCANNED}; return {} unless $self->{+_SHBANG}; return {%{$self->{+_SHBANG}}}; } sub switches { my $self = shift; my $shbang = $self->shbang or return []; my $switches = $shbang->{switches} or return []; return $switches; } sub is_executable { my $self = shift; my ($file) = @_; $file //= $self->{+FILE}; return -x $file; } sub scan { my $self = shift; $self->_scan(); return; } sub _scan { my $self = shift; return if $self->{+_SCANNED}++; return if $self->{+IS_BINARY}; my $fh = open_file($self->{+FILE}); my $comment = $self->{+COMMENT} // '#'; my %headers; for (my $ln = 1; my $line = <$fh>; $ln++) { chomp($line); next if $line =~ m/^\s*$/; if ($ln == 1 && $line =~ m/^#!/) { my $shbang = $self->_parse_shbang($line); if ($shbang) { $self->{+_SHBANG} = $shbang; if ($shbang->{non_perl}) { $self->{+NON_PERL} = 1; } next; } } # Uhg, breaking encapsulation between yath and the harness if ($line =~ m/^\s*#\s*THIS IS A GENERATED YATH RUNNER TEST/) { $headers{features}->{run} = 0; next; } next if $line =~ m/^\s*#/ && $line !~ m/^\s*#\s*HARNESS-.+/; # Ignore commented lines which aren't HARNESS-? next if $line =~ m/^\s*(use|require|BEGIN|package)\b/; # Only supports single line BEGINs last unless $line =~ m/^\s*\Q$comment\E\s*HARNESS-(.+)$/; my ($dir, $rest) = split /[-\s]+/, $1, 2; $dir = lc($dir); my @args; if ($dir eq 'meta') { @args = split /\s+/, $rest, 2; # Check for white space delimited @args = split(/[-]+/, $rest, 2) if scalar @args == 1; # Check for dash delimited $args[1] =~ s/\s+(?:#.*)?$//; # Strip trailing white space and comment if present } elsif ($rest) { $rest =~ s/\s+(?:#.*)?$//; # Strip trailing white space and comment if present @args = split /[-\s]+/, $rest; } if ($dir eq 'no') { my $feature = lc(join '_' => @args); if ($feature eq 'retry') { $headers{retry} = 0 } else { $headers{features}->{$feature} = 0; } } elsif ($dir eq 'smoke') { $headers{features}->{smoke} = 1; } elsif ($dir eq 'retry') { $headers{retry} = 1 unless @args || defined $headers{retry}; for my $arg (@args) { if ($arg =~ m/^\d+$/) { $headers{retry} = int $arg; } elsif ($arg =~ m/^iso/i) { $headers{retry} //= 1; $headers{retry_isolated} = 1; } else { warn "Unknown 'HARNESS-RETRY' argument '$arg' at $self->{+FILE} line $ln.\n"; } } } elsif ($dir eq 'yes' || $dir eq 'use') { my $feature = lc(join '_' => @args); $headers{features}->{$feature} = 1; } elsif ($dir eq 'stage') { my ($name) = @args; $headers{stage} = $name; } elsif ($dir eq 'meta') { my ($key, $val) = @args; $key = lc($key); push @{$headers{meta}->{$key}} => $val; } elsif ($dir eq 'duration' || $dir eq 'dur') { my ($name) = @args; $name = lc($name); $headers{duration} = $name; } elsif ($dir eq 'category' || $dir eq 'cat') { my ($name) = @args; $name = lc($name); if ($name =~ m/^(long|medium|short)$/i) { $headers{duration} = $name; } else { $headers{category} = $name; } } elsif ($dir eq 'conflicts') { my @conflicts_array; foreach my $arg (@args) { push @conflicts_array, lc($arg); } # Allow multiple lines with # HARNESS-CONFLICTS FOO $headers{conflicts} ||= []; push @{$headers{conflicts}}, @conflicts_array; # Make sure no more than 1 conflict is ever present. @{$headers{conflicts}} = uniq @{$headers{conflicts}}; } elsif ($dir eq 'timeout') { my ($type, $num, $extra) = @args; $type = lc($type); $num = lc($num); ($type, $num) = ('postexit', $extra) if $type eq 'post' && $num eq 'exit'; warn "'" . uc($type) . "' is not a valid timeout type, use 'EVENT' or 'POSTEXIT' at $self->{+FILE} line $ln.\n" unless $type =~ m/^(event|postexit)$/; $headers{timeout}->{$type} = $num; } elsif ($dir eq 'job' && $rest =~ m/slots\s+(\d+)(?:\s+(\d+))?$/i) { $headers{min_slots} //= $1; $headers{max_slots} //= $2 ? $2 : $1; } else { warn "Unknown harness directive '$dir' at $self->{+FILE} line $ln.\n"; } } $self->{+_HEADERS} = \%headers; } sub _parse_shbang { my $self = shift; my $line = shift; return {} if !defined $line; my %shbang; # NOTE: Test this, the dashes should be included with the switches my $shbang_re = qr{ ^ \#!.*perl.*? # the perl path (?: \s (-.+) )? # the switches, maybe \s* $ }xi; if ($line =~ $shbang_re) { my @switches; @switches = grep { m/\S/ } split /\s+/, $1 if defined $1; $shbang{switches} = \@switches; $shbang{line} = $line; } elsif ($line =~ m/^#!/ && $line !~ m/perl/i) { $shbang{line} = $line; $shbang{non_perl} = 1; } return \%shbang; } sub queue_item { my $self = shift; my ($job_name, $run_id, %inject) = @_; die "The '$self->{+FILE}' test specifies that it should not be run by Test2::Harness.\n" unless $self->check_feature(run => 1); my $category = $self->check_category; my $duration = $self->check_duration; my $stage = $self->check_stage; my $min_slots = $self->check_min_slots; my $max_slots = $self->check_max_slots; my $smoke = $self->check_feature(smoke => 0); my $fork = $self->check_feature(fork => 1); my $preload = $self->check_feature(preload => 1); my $timeout = $self->check_feature(timeout => 1); my $stream = $self->check_feature(stream => 1); my $io_events = $self->check_feature(io_events => 1); my $retry = $self->retry; my $retry_isolated = $self->retry_isolated; my $binary = $self->{+IS_BINARY} ? 1 : 0; my $non_perl = $self->{+NON_PERL} ? 1 : 0; my $et = $self->event_timeout; my $pet = $self->post_exit_timeout; my $job_class = $self->job_class; my $input = $self->input; my $test_args = $self->test_args; my $env_vars = $self->env_vars; if ($env_vars) { my $mix = delete $inject{env_vars}; $env_vars = {%$mix, %$env_vars} if $mix; } return { binary => $binary, category => $category, conflicts => $self->conflicts_list, duration => $duration, file => $self->file, rel_file => $self->relative, job_id => gen_uuid(), job_name => $job_name, run_id => $run_id, non_perl => $non_perl, stage => $stage, stamp => time, switches => $self->switches, use_fork => $fork, use_preload => $preload, use_stream => $stream, use_timeout => $timeout, smoke => $smoke, io_events => $io_events, rank => $self->rank, defined($input) ? (input => $input) : (), defined($env_vars) ? (env_vars => $env_vars) : (), defined($test_args) ? (test_args => $test_args) : (), defined($job_class) ? (job_class => $job_class) : (), defined($retry) ? (retry => $retry) : (), defined($retry_isolated) ? (retry_isolated => $retry_isolated) : (), defined($et) ? (event_timeout => $et) : (), defined($pet) ? (post_exit_timeout => $self->post_exit_timeout) : (), defined($min_slots) ? (min_slots => $min_slots) : (), defined($max_slots) ? (max_slots => $max_slots) : (), @{$self->{+QUEUE_ARGS}}, %inject, }; } my %RANK = ( smoke => 1, immiscible => 10, long => 20, medium => 50, short => 80, isolation => 100, ); sub rank { my $self = shift; return $RANK{smoke} if $self->check_feature('smoke'); my $rank = $RANK{$self->check_category}; $rank ||= $RANK{$self->check_duration}; $rank ||= 1; return $rank; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::TestFile - Abstraction of a test file and its meta-data. =head1 DESCRIPTION When Test2::Harness finds test files to run each one gets an instance of this class to represent it. This class will scan test files to find important meta data (binary vs script, inline harness directives, etc). The meta-data this class can find helps yath decide when and how to run the test. If you write a custom L or use some L callbacks you may have to use, or even construct instances of this class. =head1 SYNOPSIS use Test2::Harness::TestFile; my $tf = Test2::Harness::TestFile->new(file => "path/to/file.t"); # For an example 1, 1 works, but normally they are job_name and run_id. my $meta_data = $tf->queue_item(1, 1); =head1 ATTRIBUTES =over 4 =item $filename = $tf->file Set during object construction, and cannot be changed. =item $bool = $tf->is_binary Automatically set during construction, cannot be changed or set manually. =item $bool = $tf->non_perl Automatically set during construction, cannot be changed or set manually. =item $string = $tf->comment =item $tf->set_comment($string) Defaults to '#' can be set during construction, or changed if needed. This is used to tell yath what character(s) are used to denote a comment. This is necessary for finding harness directives. In perl the '#' character is used, and that is the default value. This is here to support non-perl tests. =item $class = $tf->job_class =item $tf->set_job_class($class) Default it undef (let the runner pick). You can change this if you want the test to run with a custom job subclass. =item $arrayref = $tf->queue_args =item $tf->set_queue_args(\@ARGS) Key/Value pairs to append to the queue_item() data. =back =head1 METHODS =over 4 =item $cat = $tf->check_category() =item $tf->set_category($cat) This is how you find the category for a file. You can use C to assign/override a category. =item $dur = $tf->check_duration() =item $tf->set_duration($dur) Get the duration of the test file ('LONG', 'MEDIUM', 'SHORT'). You can override with C. =item $stage = $tf->check_stage() =item $tf->set_stage($stage) Get the preload stage the test file thinks it should be run in. You can override with C. =item $bool = $tf->check_feature($name) This checks for the C<# HARNESS-NO-NAME> or C<# HARNESS-USE-NAME> or C<# HARNESS-YES-NAME> directives. C will result in a false boolean. C and C will result in a ture boolean. If no directive is found then C will be returned. =item $arrayref = $tf->conflicts_list() Get a list of conflict markers. =item $seconds = $tf->event_timeout() If they test specifies an event timeout this will return it. =item %headers = $tf->headers() This returns the header data from the test file. =item $bool = $tf->is_executable() Check if the test file is executable or not. =item $data = $tf->meta($key) Get the meta-data for the specific key. =item $seconds = $tf->post_exit_timeout() If the test file has a custom post-exit timeout, this will return it. =item $hashref = $tf->queue_item($job_name, $run_id) This returns the data used to add the test file to the runner queue. =item $int = $tf->rank() Returns an integer value used to sort tests into an efficient run order. =item $path = $tf->relative() Relative path to the test file. =item $tf->scan() Scan the file and populate the header data. Return nothing, takes no arguments. Automatically run by things that require the scan data. Results are cached. =item $tf->set_smoke($bool) Set smoke status. Smoke tests go to the front of the line when tests are sorted. =item $hashref = $tf->shbang() Get data gathered from parsing the tests shbang line. =item $arrayref = $tf->switches() A list of switches passed to perl, usually from the shbang line. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Settings.pm0000644000175000017500000001037615012417054021610 0ustar exodistexodistpackage Test2::Harness::Settings; use strict; use warnings; our $VERSION = '1.000158'; use Carp(); use Scalar::Util(); use Test2::Harness::Settings::Prefix; sub new { my $class = shift; my $hash; if (@_ == 1) { require Test2::Harness::Util::File::JSON; my $settings_file = Test2::Harness::Util::File::JSON->new(name => $_[0]); $hash = $settings_file->read; } else { $hash = {@_}; } for my $key (keys %$hash) { my $val = delete $hash->{$key}; if (Scalar::Util::blessed($val)) { Carp::croak("All prefixes must contain instances of Test2::Harness::Settings::Prefix") unless $val->isa('Test2::Harness::Settings::Prefix'); $hash->{$key} = $val; next; } Carp::croak("All prefixes must be defined as hashes") unless ref($val) eq 'HASH'; $hash->{$key} = Test2::Harness::Settings::Prefix->new(%$val); } return bless(\$hash, $class); } sub define_prefix { my $self = shift; my ($prefix) = @_; return ${$self}->{$prefix} //= Test2::Harness::Settings::Prefix->new; } sub check_prefix { my $self = shift; my ($prefix) = @_; return exists(${$self}->{$prefix}); } sub prefix { my $self = shift; my ($prefix, @args) = @_; Carp::croak("Too many arguments for prefix()") if @args; Carp::croak("The '$prefix' prefix is not defined") unless ${$self}->{$prefix}; return ${$self}->{$prefix}; } sub build { my $self = shift; my ($prefix, $class, @args) = @_; my $p = $self->prefix($prefix); $p->build($class, @args); } our $AUTOLOAD; sub AUTOLOAD { my $this = shift; my $prefix = $AUTOLOAD; $prefix =~ s/^.*:://g; return if $prefix eq 'DESTROY'; Carp::croak("Method $prefix() must be called on a blessed instance") unless ref($this); Carp::croak("Too many arguments for $prefix()") if @_; $this->prefix($prefix); } sub TO_JSON { my $self = shift; return {%$$self}; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Settings - Configuration settings for Test2::Harness. =head1 DESCRIPTION This module represents the options provided at the command line. Each option has a prefix, and each prefix can be accessed from the settings. =head1 SYNOPSIS # You will rarely if ever need to construct settings yourself, usually a # component of Test2::Harness will expose them to you. my $settings = $thing->settings; # All prefixes have a method generated for them via AUTOLOAD my $display = $settings->display; # You can also use the prefix method my $display = $settings->prefix('display'); # The prefix can be used in a similar way my $verbose = $settings->display->verbose; See L for more details on how to use the prefixes. =head1 METHODS Note that any prefix that does not conflict with the predefined methods can be accessed via AUTOLOAD generating the methods as needed. =over 4 =item $settings->define_prefix($prefix_name) This is used to create a prefix. =item $bool = $settings->check_prefix($prefix_name) This is used to check if a prefix is defined or not. =item $prefix = $settings->prefix($prefix_name) =item $prefix = $settings->$prefix_name This will retrieve a prefix if it exists. If the prefix is not defined this will throw an exception. If you are unsure if a prefix exists use C<$settings->check_prefix($prefix_name)>. =item $thing = $settings->build($prefix_name, $class, @args) This will create an instance of C<$class> passing the key/value pairs from the specified prefix as arguments. Additional arguments can be provided in C<@args>. =item $hashref = $settings->TO_JSON() This method allows settings to be serialized into JSON. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Auditor.pm0000644000175000017500000000774115012417054021421 0ustar exodistexodistpackage Test2::Harness::Auditor; use strict; use warnings; our $VERSION = '1.000158'; use File::Spec; use Time::HiRes qw/time/; use Test2::Harness::Util::UUID qw/gen_uuid/; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Harness::Event; use Test2::Harness::Auditor::Watcher; use Test2::Harness::Util::HashBase qw{ {+WATCHERS} //= {}; } sub process { my $self = shift; while (my $line = ) { my $data = decode_json($line); last unless defined $data; my $e = Test2::Harness::Event->new($data); # If process_event does not return anything we need to record just this # event. If it does return then we want to record what it returns. if (my @events = $self->process_event($e)) { $self->{+ACTION}->($_) for @events; } else { $self->{+ACTION}->($e); } } } sub process_event { my $self = shift; my ($e) = @_; my $job_id = $e->job_id; my $job_try = $e->job_try // 0; # Do nothing for non-job events return $e unless $job_id; my $f = $e->facet_data; if (my $task = $f->{harness_job_queued}) { $self->{+WATCHERS}->{$job_id} //= []; $self->{+QUEUED}->{$job_id} //= $task; return $e; } my $tries = $self->{+WATCHERS}->{$job_id} or return $self->broken($e, "Never saw queue entry"); if (my $job = $f->{harness_job}) { $tries->[$job_try] = Test2::Harness::Auditor::Watcher->new(job => $job, try => $job_try); } my $watcher = $tries->[$job_try] or return $self->broken($e, "never saw harness_job facet"); return $watcher->process($e); } sub broken { my $self = shift; my ($e, $message) = @_; $self->{+BROKEN}->{$e->job_id}++; push @{$e->facet_data->{errors} //= []} => {details => $message, fail => 1}; return $e; } sub finish { my $self = shift; my $final_data = {pass => 1}; while (my ($job_id, $watchers) = each %{$self->{+WATCHERS}}) { my $file = File::Spec->abs2rel($self->{+QUEUED}->{$job_id}->{file}); if (@$watchers) { push @{$final_data->{failed}} => [$job_id, $file, $watchers->[-1]->failed_subtest_tree] if $watchers->[-1]->fail; push @{$final_data->{retried}} => [$job_id, scalar(@$watchers), $file, $watchers->[-1]->pass ? 'YES' : 'NO'] if @$watchers > 1; if (my $halt = $watchers->[-1]->halt) { push @{$final_data->{halted}} => [$job_id, $file, $halt]; } } else { push @{$final_data->{unseen}} => [$job_id, $self->{+QUEUED}->{$job_id}->{file}]; } } $final_data->{pass} = 0 if $final_data->{failed} or $final_data->{unseen}; my $e = Test2::Harness::Event->new( job_id => 0, stamp => time, event_id => gen_uuid(), run_id => $self->{+RUN_ID}, facet_data => {harness_final => $final_data}, ); $self->{+ACTION}->($e); $self->{+ACTION}->(undef); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Auditor - Auditor that validates test results by processing an event stream. =head1 DESCRIPTION The auditor is responsible for taking a stream of events and determining what is passing or failing. An L instance is created for every job_id seen, and events for each job are passed to the proper watcher for state management. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Runner.pm0000644000175000017500000004116615012417054021262 0ustar exodistexodistpackage Test2::Harness::Runner; use strict; use warnings; our $VERSION = '1.000158'; use File::Spec(); use Carp qw/confess croak/; use Fcntl qw/LOCK_EX LOCK_UN/; use POSIX qw/:sys_wait_h/; use Long::Jump qw/setjump longjump/; use Time::HiRes qw/sleep time/; use Scope::Guard; use Test2::Harness::Util qw/clean_path file2mod mod2file open_file parse_exit write_file_atomic process_includes chmod_tmp write_file/; use Test2::Harness::Util::Queue(); use Test2::Harness::Util::JSON(qw/encode_json/); use Test2::Harness::Runner::Constants; use Test2::Harness::Runner::Run(); use Test2::Harness::Runner::Job(); use Test2::Harness::Runner::Spawn(); use Test2::Harness::Runner::State(); use Test2::Harness::Runner::Preload(); use Test2::Harness::Runner::Preloader(); use Test2::Harness::Runner::Preloader::Stage(); use Test2::Harness::Runner::DepTracer(); use parent 'Test2::Harness::IPC'; use Test2::Harness::Util::HashBase( # Fields from settings qw{ {+ROOTPID} = $$; $RUNNER_PID = $$; croak "'dir' is a required attribute" unless $self->{+DIR}; croak "'settings' is a required attribute" unless $self->{+SETTINGS}; my $dir = clean_path($self->{+DIR}); croak "'$dir' is not a valid directory" unless -d $dir; $self->{+DIR} = $dir; $self->{+HANDLERS}->{HUP} = sub { my $sig = shift; print "$$ $0 ($self->{+STAGE}) Runner caught SIG$sig, reloading...\n"; $self->{+SIGNAL} = $sig; }; my $tmp_dir = File::Spec->catdir($self->{+DIR}, 'tmp'); unless (-d $tmp_dir) { mkdir($tmp_dir) or die "Could not create temp dir: $!"; chmod_tmp($tmp_dir); } $self->{+TMP_DIR} = $tmp_dir; my $have_job_limiter = 0; for my $res (@{$self->{+RESOURCES}}) { require(mod2file($res)) unless ref($res); $have_job_limiter++ if $res->job_limiter; } unless ($have_job_limiter) { require Test2::Harness::Runner::Resource::JobCount; unshift @{$self->{+RESOURCES}} => 'Test2::Harness::Runner::Resource::JobCount'; } $self->SUPER::init(); } sub preloader { my $self = shift; $self->{+PRELOADER} //= Test2::Harness::Runner::Preloader->new( dir => $self->{+DIR}, preloads => $self->preloads, monitor => $self->{+MONITOR_PRELOADS}, restrict_reload => $self->{+RESTRICT_RELOAD}, dump_depmap => $self->{+DUMP_DEPMAP}, reload => $self->{+RELOAD}, below_threshold => ($self->{+PRELOAD_THRESHOLD} && $self->{+JOBS_TODO} && $self->{+PRELOAD_THRESHOLD} > $self->{+JOBS_TODO}) ? 1 : 0, ); } sub state { my $self = shift; my $preloader = $self->preloader; my $settings = $self->settings; $self->{+STATE} //= Test2::Harness::Runner::State->new( workdir => $self->{+DIR}, eager_stages => $preloader->eager_stages // {}, preloader => $preloader, resources => [map { $_->new(settings => $settings) } @{$self->{+RESOURCES}}], settings => $settings, ); } sub check_timeouts { my $self = shift; return unless $self->settings->runner->use_timeout; my $now = time; # Check only once per second, that is as granular as we get. Also the check is not cheep. return if $self->{+LAST_TIMEOUT_CHECK} && $now < (1 + $self->{+LAST_TIMEOUT_CHECK}); for my $pid (keys %{$self->{+PROCS}}) { my $job = $self->{+PROCS}->{$pid}; next unless $job->isa('Test2::Harness::Runner::Job'); next unless $job->use_timeout; my $et = $job->event_timeout // $self->{+EVENT_TIMEOUT}; my $pet = $job->post_exit_timeout // $self->{+POST_EXIT_TIMEOUT}; next unless $et || $pet; my $changed = $job->output_changed(); my $delta = $now - $changed; # Event timout if we are checking for one, and if the delta is larger than the timeout. my $e_to = $et && $delta > $et; # Post-Exit timeout if we are checking for one, the process has exited (we are waiting) and the delta is larger than the timeout. my $pe_to = $pet && $self->{+WAITING}->{$pid} && $delta > $pet; next unless $e_to || $pe_to; my $kill = -f $job->et_file || -f $job->pet_file; write_file_atomic($job->et_file, "$now $delta") if $e_to && !-f $job->et_file; write_file_atomic($job->pet_file, "$now $delta") if $pe_to && !-f $job->pet_file; my $sigmap = $self->SIG_MAP; my $sig = $kill ? $sigmap->{'KILL'} : $sigmap->{'TERM'}; $sig = "-$sig" if $self->USE_P_GROUPS; print STDERR "$$ $0 " . $job->file . " did not respond to SIGTERM, sending SIGKILL to $pid...\n" if $kill; # storing the jobid we had to stop $self->{run_reached_timeout} //= {}; $self->{run_reached_timeout}->{$job->task->{job_id}} = $pid; kill($sig, $pid); } $self->{+LAST_TIMEOUT_CHECK} = time; } sub stop { my $self = shift; $self->check_for_fork; if (keys %{$self->{+PROCS}}) { print "$$ $0 Sending all child processes the TERM signal...\n"; # Send out the TERM signal $self->killall($self->{+SIGNAL} // 'TERM'); $self->wait(all => 1, timeout => 5); } # Time to get serious if (keys %{$self->{+PROCS}}) { print STDERR "$$ $0 Some child processes are refusing to exit, sending KILL signal...\n"; print("$$ $0 == $_ " . waitpid($_, WNOHANG) . "\n") for keys %{$self->{+PROCS}}; $self->killall('KILL'); } $self->SUPER::stop(); } sub dispatch_lock_file { my $self = shift; return $self->{+DISPATCH_LOCK_FILE} //= File::Spec->catfile($self->{+DIR}, 'dispatch.lock'); } sub handle_sig { my $self = shift; my ($sig) = @_; return if $self->{+SIGNAL}; return $self->{+HANDLERS}->{$sig}->($sig) if $self->{+HANDLERS}->{$sig}; $self->{+SIGNAL} = $sig; die "Runner caught SIG$sig. Attempting to shut down cleanly...\n"; } sub all_libs { my $self = shift; my @out; push @out => @{$self->{+INCLUDES}} if $self->{+INCLUDES}; push @out => 't/lib' if $self->{+TLIB}; push @out => 'lib' if $self->{+LIB}; if ($self->{+BLIB}) { push @out => 'blib/lib'; push @out => 'blib/arch'; } return @out; } sub process { my $self = shift; @INC = process_includes( list => [@{$self->settings->harness->dev_libs}, $self->all_libs], include_dot => $self->unsafe_inc, include_current => 1, clean => 1, ); my $pidfile = File::Spec->catfile($self->{+DIR}, 'PID'); write_file_atomic($pidfile, "$$"); $self->start(); my $ok = eval { $self->run_tests(); 1 }; my $err = $@; $self->{+CAN_STAGE} = 0; warn $err unless $ok; $self->stop(); return $self->{+SIGNAL} ? 128 + $self->SIG_MAP->{$self->{+SIGNAL}} : $ok ? 0 : 1; } sub spawn_scheduler { my $self = shift; return unless $self->{+ROOTPID} == $$; my $pid = fork // die "Could not fork: $!"; return $self->watch_pid($pid) if $pid; my $guard = Scope::Guard->new(sub { print STDERR "\n\nEscaped Scope!!!!\n\n"; print STDERR $@; exit 255; }); $0 =~ s/-runner/-scheduler/i; my $state = $self->state; my $lock = open_file($self->dispatch_lock_file, '>>'); while (1) { $state->poll; flock($lock, LOCK_EX) or die "Could not get scheduler lock: $!"; while (1) { next if $state->advance; last; } flock($lock, LOCK_UN) or die "Could not release scheduler lock: $!"; if ($self->end_test_loop()) { $guard->dismiss; exit(0); } my $slept = 0; if ($self->{+WAIT_TIME}) { # This sleep is often interrupted by signals. while ($slept < $self->{+WAIT_TIME}) { $slept += sleep($self->{+WAIT_TIME} - $slept); } } } warn "Escaped scheduler loop"; exit 255; } sub run_tests { my $self = shift; my $preloader = $self->preloader; $preloader->preload(); $self->spawn_scheduler(); my ($stage, @procs) = $preloader->preload_stages(); if ($self->dump_depmap) { if (my $dtrace = $preloader->dtrace) { if (my $depmap = $dtrace->dep_map) { my $file = "depmap-$stage.json"; write_file($file, encode_json($depmap)); } } } $self->watch($_) for @procs; while(1) { $self->{+CAN_STAGE} = 1; my $jump = setjump "Stage-Runner" => sub { $self->run_stage($stage); }; last unless $jump; ($stage) = @$jump; $self->reset_stage(); } return; } sub reset_stage { my $self = shift; # Normalize IPC $self->check_for_fork(); # If no stage was set we do not want to clear this, root stages need to # preserve the preloads return unless $self->{+STAGE}; # From Runner delete $self->{+STAGE}; delete $self->{+STATE}; delete $self->{+LAST_TIMEOUT_CHECK}; return; } sub run_stage { my $self = shift; my ($stage) = @_; $self->{+STAGE} = $stage; $self->state->stage_ready($stage); while (1) { next if $self->run_job(); next if $self->wait(); last if $self->end_test_loop(); sleep($self->{+WAIT_TIME}) if $self->{+WAIT_TIME}; } $self->state->stage_down($stage); $self->killall($self->{+SIGNAL}) if $self->{+SIGNAL}; $self->wait(all => 1); exit 0 unless $stage eq 'base' || $stage eq 'default'; } sub run_job { my $self = shift; my $task = $self->state->next_task($self->{+STAGE}) or return 0; if ($task->{spawn} && !$task->{resource_skip}) { my $job = Test2::Harness::Runner::Spawn->new( runner => $self, task => $task, settings => $self->settings, fork_callback => $self->{+FORK_SPAWN_CALLBACK}, ); $self->{+FORK_SPAWN_CALLBACK}->($self, $job); return 1; } my $run = $self->state->run(); return 1 unless $run; my $job_class; if ($task->{job_class}) { $job_class = $task->{job_class}; require(mod2file($job_class)); die "Custom job class $job_class overrode the category, this is a fatal mistake" unless $job_class->category eq $self->job_class->category; } else { $job_class = $self->job_class; } my $job = $job_class->new( runner => $self, task => $task, run => $run, settings => $self->settings, fork_callback => $self->{+FORK_JOB_CALLBACK}, ); $job->prepare_dir(); my $spawn_time; my $pid; my $via = $job->via(); if ($via) { require(mod2file($1)) if !defined(&{$via}) && $via =~ m/^(.+)::[^:]+$/; $spawn_time = time(); $pid = $self->$via($job); $job->set_pid($pid); $self->watch($job); } else { $spawn_time = time(); $self->spawn($job); $pid = $job->pid; } my $json_data = $job->TO_JSON(); $json_data->{stamp} = $spawn_time; $run->jobs->write($json_data); return $pid; } sub end_test_loop { my $self = shift; my $state = $self->state; no warnings 'uninitialized'; if (!$self->{+STAGE} || $self->{+STAGE} eq 'default' || $self->{+STAGE} eq 'base') { $self->{+RESPAWN_RUNNER_CALLBACK}->() if $self->preloader->check($state) || ($self->{+SIGNAL} && $self->{+SIGNAL} eq 'HUP'); } if ($self->preloader->check($state)) { $self->{+SIGNAL} //= 'HUP'; return 1; } return 1 if $self->{+SIGNAL}; return 1 if $state->done; return 0; } sub set_proc_exit { my $self = shift; my ($proc, $exit, $time, @args) = @_; if ($proc->isa('Test2::Harness::Runner::Job')) { my $task = $proc->task; my $timed_out = 0; if ( !$exit && ref $self->{run_reached_timeout} && $self->{run_reached_timeout}->{ $task->{job_id} } ) { delete $self->{run_reached_timeout}->{ $task->{job_id} }; $timed_out = 1; } if (($exit || $timed_out) && $proc->is_try < $proc->retry ) { $self->state->retry_task($task->{job_id}); push @args => 'will-retry'; } else { $self->state->stop_task($task->{job_id}); } if(my $bail = $exit ? $proc->bailed_out : 0) { print "$$ $0 BAIL-OUT detected: $bail\n"; if ($self->settings->runner->abort_on_bail) { print "$$ $0 Aborting the test run...\n"; $self->state->halt_run($task->{run_id}); } } } elsif ($proc->isa('Test2::Harness::Runner::Preloader::Stage')) { my $stage = $proc->name; if ($exit != 0) { my $e = parse_exit($exit); my $err = "$$ $0 Child stage '$stage' did not exit cleanly (sig: $e->{sig}, err: $e->{err})!\n"; $self->{+MONITOR_PRELOADS} ? warn $err : die $err; } if ($self->{+MONITOR_PRELOADS} && $self->{+CAN_STAGE} && !$self->end_test_loop) { my $pid = $$; my ($name, @procs) = $self->preloader->_preload_stages($stage); $self->watch($_) for @procs; longjump "Stage-Runner" => $name unless $pid == $$; } } $self->SUPER::set_proc_exit($proc, $exit, $time, @args); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner - Base class for test runners =head1 DESCRIPTION This module does the heavy lifting of running all the tests. You should never need to create an instance of the runner yourself. In most cases the runner module is exposed via a callback or a plugin affordance. =head1 PUBLIC METHODS =head2 FROM SETTINGS These are attributesd with values set from the L instance created from command line arguments. See L for the most up to date documentation on these. =over 4 =item $runner->includes =item $runner->tlib =item $runner->lib =item $runner->blib =item $runner->unsafe_inc =item $runner->use_fork =item $runner->preloads =item $runner->preload_threshold =item $runner->switches =item $runner->cover =item $runner->event_timeout =item $runner->post_exit_timeout =back =head2 FROM CONSTRUCTION These attributes are set when the runner is created. =over 4 =item $path = $runner->dir Path to the working directory. =item $settings = $runner->settings The L instance. =item $coderef = $runner->fork_job_callback Callback used to spawn new tests via fork. =item $coderef = $runner->respawn_runner_callback Callback to restart the runner process. =item $bool = $runner->monitor_preloads True if preloads should be watched for changes. =item $int = $runner->jobs_todo A count of total jobs to run. This will always be 0 in a persistent runner. =back =head2 OTHER PUBLIC METHODS If a method is not documented here then it is an implementation detail and you should not use it. =over 4 =item $class = $runner->job_class Class for new test jobs. =item $preload = $runner->preloader Get the L instance. =item $state = $runner->state Get the L instance. =item @list = $runner->all_libs Get all the libs that should be added to @INC by default. Note that specific runs and even specific tests can have custom paths on top of these. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Finder.pm0000644000175000017500000006531715012417054021224 0ustar exodistexodistpackage Test2::Harness::Finder; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Harness::Util qw/clean_path mod2file/; use Test2::Harness::Util::JSON qw/decode_json encode_json/; use List::Util qw/first/; use Cwd qw/getcwd/; use Carp qw/croak/; use Time::HiRes qw/time/; use Text::ParseWords qw/quotewords/; use Test2::Harness::TestFile; use File::Spec; use Test2::Harness::Util::HashBase qw{ {+EXCLUDE_FILES} = { map {( $_ => 1 )} @{$self->{+EXCLUDE_FILES}} } if ref($self->{+EXCLUDE_FILES}) eq 'ARRAY'; if (my $plugins = $self->{+RERUN_PLUGIN}) { for (@$plugins) { $_ = "App::Yath::Plugin::$_" unless s/^\+// or m/^(App::Yath|Test2::Harness)::Plugin::/; my $file = mod2file($_); require $file; } } } sub duration_data { my $self = shift; my ($plugins, $settings, $test_files) = @_; $self->{+DURATION_DATA} //= $self->pull_durations(); return $self->{+DURATION_DATA} if $self->{+DURATION_DATA}; for my $plugin (@$plugins) { next unless $plugin->can('duration_data'); $self->{+DURATION_DATA} = $plugin->duration_data($settings, $test_files) or next; last; } return $self->{+DURATION_DATA} //= {}; } sub pull_durations { my $self = shift; my $primary = delete $self->{+MAYBE_DURATIONS}; my $fallback = delete $self->{+DURATIONS}; my @args = ( name => 'durations', is_json => 1, http_args => [{headers => {'Content-Type' => 'application/json'}}], ); if ($primary) { local $@; my $durations = eval { $self->_pull_from_file_or_url(source => $primary, @args) } or print "Could not fetch optional durations '$primary', ignoring...\n"; if ($durations) { print "Found durations: $primary\n"; return $durations; } } return $self->_pull_from_file_or_url(source => $fallback, @args) if $fallback; return; } sub add_exclusions_from_lists { my $self = shift; my @lists = ref($self->{+EXCLUDE_LISTS}) eq 'ARRAY' ? @{$self->{+EXCLUDE_LISTS}} : ($self->{+EXCLUDE_LISTS}); for my $path (@lists) { my $content = $self->_pull_from_file_or_url( source => $path, name => 'exclusion lists', ); next unless $content; for (split(/\r?\n\r?/, $content)) { $self->{+EXCLUDE_FILES}->{$_} = 1 unless /^\s*#/; }; } } sub _pull_from_file_or_url { my $self = shift; my %params = @_; my $in = $params{source} // croak "No file or url provided"; my $name = $params{name} // croak "No name provided"; my $is_json = $params{is_json}; if (my $type = ref($in)) { return $in if $is_json && ($type eq 'HASH' || $type eq 'ARRAY'); } elsif (-f $in) { if ($is_json) { require Test2::Harness::Util::File::JSON; my $file = Test2::Harness::Util::File::JSON->new(name => $in); return $file->read(); } else { require Test2::Harness::Util::File; my $f = Test2::Harness::Util::File->new(name => $in); return $f->read(); } } elsif ($in =~ m{^https?://}) { my $meth = $params{http_method} // 'get'; my $args = $params{http_args}; require HTTP::Tiny; my $ht = HTTP::Tiny->new(); my $res = $ht->$meth($in, $args ? (@$args) : ()); die "Could not query $name from '$in'\n$res->{status}: $res->{reason}\n$res->{content}\n" unless $res->{success}; return $is_json ? decode_json($res->{content}) : $res->{content}; } die "Invalid $name specification: $in"; } sub find_files { my $self = shift; my ($plugins, $settings) = @_; $self->add_exclusions_from_lists() if $self->{+EXCLUDE_LISTS}; my $add_changes = 0; $add_changes ||= $self->{+CHANGED} && @{$self->{+CHANGED}}; $add_changes ||= $self->{+CHANGED_ONLY}; $add_changes ||= $self->{+CHANGES_PLUGIN}; $add_changes ||= $self->{+CHANGES_DIFF}; $self->add_changed_to_search($plugins, $settings) if $add_changes; my $add_rerun = $self->{+RERUN}; $self->add_rerun_to_search($plugins, $settings, $add_rerun) if $add_rerun; return $self->find_multi_project_files($plugins, $settings) if $self->multi_project; return $self->find_project_files($plugins, $settings, $self->search); } sub check_plugins { my $self = shift; my ($plugins, $settings) = @_; my $check_plugins = $plugins; my $plugin; if (my $p = $self->{+CHANGES_PLUGIN}) { $plugin = $p =~ s/^\+// ? $p : "App::Yath::Plugin::$p"; $check_plugins = [$plugin]; } return $check_plugins // []; } sub get_diff { my $self = shift; my ($plugins, $settings) = @_; return (file => $self->{+CHANGES_DIFF}) if $self->{+CHANGES_DIFF}; my $check_plugins = $self->check_plugins($plugins, $settings); for my $plugin (@$check_plugins) { if ($plugin->can('changed_diff')) { my ($type, $data) = $plugin->changed_diff($settings); next unless $type && $data; return ($type => $data); } } return (); } sub find_changes { my $self = shift; my ($plugins, $settings) = @_; my @listed_changes; @listed_changes = @{$self->{+CHANGED}} if $self->{+CHANGED}; my ($type, $diff) = $self->get_diff($plugins, $settings); my (@found_changes); if ($type && $diff) { @found_changes = $self->changes_from_diff($type => $diff, $settings); } unless (@found_changes) { my $check_plugins = $self->check_plugins($plugins, $settings); for my $plugin (@$check_plugins) { next unless $plugin->can('changed_files'); push @found_changes => $plugin->changed_files($settings); last if @found_changes; } } my $filter_patterns = @{$self->{+CHANGES_FILTER_PATTERN}} ? $self->{+CHANGES_FILTER_PATTERN} : undef; my $filter_files = @{$self->{+CHANGES_FILTER_FILE}} ? {map { $_ => 1 } @{$self->{+CHANGES_FILTER_FILE}}} : undef; my $exclude_patterns = @{$self->{+CHANGES_EXCLUDE_PATTERN}} ? $self->{+CHANGES_EXCLUDE_PATTERN} : undef; my $exclude_files = @{$self->{+CHANGES_EXCLUDE_FILE}} ? {map { $_ => 1 } @{$self->{+CHANGES_EXCLUDE_FILE}}} : undef; my %changed_map; for my $change (@listed_changes, @found_changes) { next unless $change; my ($file, @parts) = ref($change) ? @$change : ($change); next if $filter_files && !$filter_files->{$file}; next if $exclude_files && $exclude_files->{$file}; next if $filter_patterns && !first { $file =~ m/$_/ } @$filter_patterns; next if $exclude_patterns && first { $file =~ m/$_/ } @$exclude_patterns; @parts = ('*') unless @parts; $changed_map{$file}{$_} = 1 for @parts; } return \%changed_map; } sub get_capable_plugins { my $self = shift; my ($method, $plugins) = @_; my %seen; return grep { $_ && !$seen{$_}++ && $_->can($method) } @$plugins; } sub add_rerun_to_search { my $self = shift; my ($plugins, $settings, $rerun) = @_; my $search = $self->search; unless ($search) { $search = []; $self->set_search($search); } my $modes = $self->{+RERUN_MODES}; my $mode_hash = { map {$_ => 1} @$modes }; my ($grabbed, $data); for my $p ($self->get_capable_plugins(grab_rerun => [@{$self->{+RERUN_PLUGIN} // []}, @$plugins])) { ($grabbed, $data) = $p->grab_rerun($rerun, modes => $modes, mode_hash => $mode_hash, settings => $settings); next unless $grabbed; unless ($data && keys %$data) { print "No files found to rerun.\n"; exit 0; } last if $grabbed; } unless ($grabbed) { if ($rerun eq '1') { $rerun = first { -e $_ } qw{ ./lastlog.jsonl ./lastlog.jsonl.bz2 ./lastlog.jsonl.gz }; die "Could not find a lastlog.jsonl(.bz2|.gz) file for re-running, you may need to provide a full path to --rerun=... or --rerun-failed=..." unless $rerun; } die "'$rerun' is not a valid log file, and no plugin intercepted it.\n" unless -f $rerun; my $stream = Test2::Harness::Util::File::JSONL->new(name => $rerun, skip_bad_decode => 1); my %files; while (1) { my @events = $stream->poll(max => 1000) or last; for my $event (@events) { my $f = $event->{facet_data} or next; for my $type (qw/seen queued start end/) { my $field = $type eq 'seen' ? "harness_job" : "harness_job_$type"; my $data = $f->{$field} or next; my $file = $data->{rel_file} // $data->{run_file} // $data->{file} // $data->{abs_file}; next unless $file; my $ref = $files{$file} //= {}; $ref->{$type}++; $ref->{$data->{fail} ? 'fail' : 'pass'}++ if $type eq 'end'; $ref->{retry}++ if $data->{is_try}; } } } $data = \%files; } my @add = map { $data->{$_}->{add} // $_ } grep { my $entry = $data->{$_}; my $keep = $mode_hash->{all} ? 1 : 0; $keep ||= 1 if $mode_hash->{failed} && $entry->{fail} && !$entry->{pass}; $keep ||= 1 if $mode_hash->{retried} && $entry->{retry}; $keep ||= 1 if $mode_hash->{passed} && $entry->{pass}; $keep ||= 1 if $mode_hash->{missed} && !$entry->{end}; $keep } sort keys %$data; unless (@add) { print "No files found to rerun.\n"; exit 0; } push @$search => @add; } sub add_changed_to_search { my $self = shift; my ($plugins, $settings) = @_; my $search = $self->search; unless ($search) { $search = []; $self->set_search($search); } my $changed_map = $self->find_changes($plugins, $settings); my $found_changed = keys %$changed_map; die "Could not find any changed files.\n" if $self->{+CHANGED_ONLY} && !$found_changed; if ($self->{+CHANGED_ONLY}) { die "Can not add test or directory names when using --changed-only (saw: " . join(", " => @$search) . ")\n" if @$search; } if ($self->{+SHOW_CHANGED_FILES} && $found_changed) { print "Found the following changed files:\n"; for my $file (keys %$changed_map) { print " $file: ", join(", ", sort keys %{$changed_map->{$file}}), "\n"; } } my @add; for my $p ($self->get_capable_plugins(get_coverage_tests => $plugins)) { for my $set ($p->get_coverage_tests($settings, $changed_map)) { my $test = ref($set) ? $set->[0] : $set; unless (-e $test) { print STDERR "Coverage wants to run test '$test', but it does not exist, skipping...\n"; next; } push @add => $set; } } for my $p ($self->get_capable_plugins(post_process_coverage_tests => $plugins)) { $p->post_process_coverage_tests($settings, \@add); } if ($self->{+SHOW_CHANGED_FILES} && @add) { print "Found " . scalar(@add) . " test files to run based on changed files.\n"; print ref($_) ? " $_->[0]" : " $_\n" for @add; print "\n"; } push @$search => @add; return; } sub changes_from_diff { my $self = shift; my ($type, $data, $settings) = @_; my $next; if ($type eq 'lines') { $next = sub { shift @$data }; } elsif ($type eq 'diff') { my $lines = [split /\n/, $data]; $next = sub { shift @$lines }; } elsif ($type eq 'file') { die "'$data' is not a valid diff file.\n" unless -f $data; open(my $fh, '<', $data) or die "Could not open diff file '$data': $!"; $next = sub { my $line = <$fh>; close($fh) unless defined $line; return $line; }; } elsif ($type eq 'line_sub') { $next = $data; } elsif ($type eq 'handle') { $next = sub { scalar <$data> }; } else { die "Invalid diff type '$type'"; } my %changed; # Only perl can parse perl, and nothing can parse perl diff. What this does # is take a diff of every file with 100% context so we see the entire file # with the +, minus, or space prefix. As we scan it we look for subs. We # track what files and subs we are in. When we see a change we # {$file}{$sub}++. # # This of course is broken if you make a change between # subs as it will attribute it to the previous sub, however tracking # indentation is equally flawed as things like heredocs and other special # perl things can also trigger that to prematurely think we are out of a # sub. # # PPI and similar do a better job parsing perl, but using them and also # tracking changes from the diff, or even asking them to parse a diff where # some lines are added and others removed is also a huge hassle. # # The current algorith is "good enough", not perfect. my ($file, $sub, $indent, $is_perl); while (my $line = $next->()) { chomp($line); if ($line =~ m{^(?:---|\+\+\+) ([ab]/)?(.*)$}) { my $maybe_prefix = $1; my $maybe_file = $2; next if $maybe_file =~ m{/dev/null}; if ($maybe_prefix) { $file = -f "$maybe_prefix$maybe_file" ? "$maybe_prefix$maybe_file" : $maybe_file; } else { $file = $maybe_file; } $is_perl = 1 if $file =~ m/\.(pl|pm|t2?)$/; $sub = '*'; # Wildcard, changes to the code outside of a sub potentially effects all subs next; } next unless $file; $line =~ m/^( |-|\+)(.*)$/ or next; my ($prefix, $statement) = ($1, $2); my $changed = $prefix eq ' ' ? 0 : 1; $is_perl = 1 if $statement =~ m/^#!.*perl/; if ($statement =~ m/^(\s*)sub\s+(\w+)/) { $indent = $1 // ''; $sub = $2; # 1-line sub: sub foo { ... } if ($statement =~ m/}/) { $changed{$file}{$sub}++ if $changed; $sub = '*'; $indent = undef; next; } } elsif(defined($indent) && $statement =~ m/^$indent\}/) { $indent = undef; $sub = "*"; # If this is nothing but whitespace and a closing paren we can skip it. next if $statement =~ m/^\s*\}?\s*$/ && !$self->{+CHANGES_INCLUDE_WHITESPACE}; } next unless $sub; # If sub is empty then we are not even in a file yet next unless $changed; # If we are not on a changed line no need to add it unless ($self->{+CHANGES_INCLUDE_WHITESPACE}) { next if !length($statement); # If there is no statement length then this is whitespace only next if $statement =~ m/^\s+$/; # Do not care about whitespace only changes } next if $is_perl && $self->{+CHANGES_EXCLUDE_NONSUB} && $sub eq '*'; $changed{$file}{$sub}++; } return map {([$_ => sort keys %{$changed{$_}}])} sort keys %changed; } sub find_multi_project_files { my $self = shift; my ($plugins, $settings) = @_; my $search = $self->search // []; die "multi-project search must be a single directory, or the current directory" if @$search > 1; my ($pdir) = @$search; my $dir = clean_path(getcwd()); my $out = []; my $ok = eval { chdir($pdir) if defined $pdir; my $ret = clean_path(getcwd()); opendir(my $dh, '.') or die "Could not open project dir: $!"; for my $subdir (readdir($dh)) { chdir($ret); next if $subdir =~ m/^\./; my $path = clean_path(File::Spec->catdir($ret, $subdir)); next unless -d $path; chdir($path) or die "Could not chdir to $path: $!\n"; for my $item (@{$self->find_project_files($plugins, $settings, [])}) { push @{$item->queue_args} => ('ch_dir' => $path); push @$out => $item; } } chdir($ret); 1; }; my $err = $@; chdir($dir); die $err unless $ok; return $out; } sub find_project_files { my $self = shift; my ($plugins, $settings, $input) = @_; $input //= []; $plugins //= []; my $default_search = [@{$self->default_search}]; push @$default_search => @{$self->default_at_search} if $settings->check_prefix('run') && $settings->run->author_testing; $_->munge_search($input, $default_search, $settings) for @$plugins; my $search = @$input ? $input : $self->{+CHANGED_ONLY} ? [] : $default_search; die "No tests to run, search is empty\n" unless @$search; my (%seen, @tests, @dirs); for my $item (@$search) { my ($path, $test_params); if (ref $item) { ($path, $test_params) = @$item; } else { my ($type, $data); ($path, $type, $data) = split /(:<|:@|:=)/, $item, 2; if ($type && $data) { $test_params = {}; if ($type eq ':<') { $test_params->{stdin} = $data; } elsif ($type eq ':@') { $test_params->{argv} = decode_json($data); } elsif ($type eq ':=') { $test_params->{env} = decode_json($data); } } } push @dirs => $path and next if -d $path; unless(-f $path) { my ($actual, $args) = split /=/, $path, 2; if (-f $actual) { $path = $actual; $test_params = {%{$test_params // {}}, argv => [quotewords('\s+', 0, $args)]}; } else { die "'$path' is not a valid file or directory.\n" if @$input; next; } } $path = clean_path($path, 0); $seen{$path}++; my $test; unless (first { $test = $_->claim_file($path, $settings, from => 'listed') } @$plugins) { $test = Test2::Harness::TestFile->new(file => $path); } if (my @exclude = $self->exclude_file($test)) { if (@$input) { print STDERR "File '$path' was listed on the command line, but has been exluded for the following reasons:\n"; print STDERR " $_\n" for @exclude; } next; } if ($test_params) { $test->set_input($test_params->{stdin}) if $test_params->{stdin}; $test->set_test_args($test_params->{argv}) if $test_params->{argv}; $test->set_env_vars($test_params->{env}) if $test_params->{env}; } push @tests => $test; } if (@dirs) { require File::Find; File::Find::find( { no_chdir => 1, wanted => sub { no warnings 'once'; my $file = clean_path($File::Find::name, 0); return if $seen{$file}++; return unless -f $file; my $test; unless(first { $test = $_->claim_file($file, $settings, from => 'search') } @$plugins) { for my $ext (@{$self->extensions}) { next unless m/\.\Q$ext\E$/; $test = Test2::Harness::TestFile->new(file => $file); last; } } return unless $test; return unless $self->include_file($test); push @tests => $test; }, }, @dirs ); } my $test_count = @tests; my $threshold = $settings->finder->durations_threshold // 0; if ($threshold && $test_count >= $threshold) { my $start = time; my $durations = $self->duration_data($plugins, $settings, [map { $_->relative } @tests]); my $end = time; if ($durations && keys %$durations) { printf("Fetched duration data (Took %0.2f seconds)\n", $end - $start); for my $test (@tests) { my $rel = $test->relative; $test->set_duration($durations->{$rel}) if $durations->{$rel}; } } } $_->munge_files(\@tests, $settings) for @$plugins; return [ sort { $a->rank <=> $b->rank || $a->file cmp $b->file } @tests ]; } sub include_file { my $self = shift; my ($test) = @_; my @exclude = $self->exclude_file($test); return !@exclude; } sub exclude_file { my $self = shift; my ($test) = @_; my @out; push @out => "File has a do-not-run directive inside it." unless $test->check_feature(run => 1); my $full = $test->file; my $rel = $test->relative; push @out => 'File is in the exclude list.' if $self->exclude_files->{$full} || $self->exclude_files->{$rel}; push @out => 'File matches an exclusion pattern.' if first { $rel =~ m/$_/ } @{$self->exclude_patterns}; push @out => 'File is marked as "long", but the "no long tests" opition was specified.' if $self->no_long && $test->check_duration eq 'long'; push @out => 'File is not marked "long", but the "only long tests" option was specified.' if $self->only_long && $test->check_duration ne 'long'; return @out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Finder - Library that searches for test files =head1 DESCRIPTION The finder is responsible for locating test files that should be run. You can subclass the finder and instruct yath to use your subclass. =head1 SYNOPSIS =head2 USING A CUSTOM FINDER To use Test2::Harness::Finder::MyFinder: $ yath test --finder MyFinder To use Another::Finder $ yath test --finder +Another::Finder By default C is prefixed onto your custom finder, use '+' before the class name or prevent this. =head2 SUBCLASSING use parent 'Test2::Harness::Finder'; use Test2::Harness::TestFile; # Custom finders may provide their own options if desired. # This is optional. use App::Yath::Options; option foo => ( ... ); # This is the main method to override. sub find_project_files { my $self = shift; my ($plugins, $settings, $search) = @_; return [ Test2::Harness::TestFile->new(...), Test2::Harness::TestFile->new(...), ..., ]; } =head1 METHODS These are important state methods, as well as utility methods for use in your subclasses. =over 4 =item $bool = $finder->multi_project True if the C command was used. =item $arrayref = $finder->find_files($plugins, $settings) This is the main method. This method returns an arrayref of L instances, each one representing a single test to run. $plugins is a list of plugins, some may be class names, others may be instances. $settings is an L instance. B In many cases it is better to override C in your subclasses. =item $durations = $finder->duration_data This will fetch the durations data if any was provided. This is a hashref of relative test paths as keys where the value is the duration of the file (SHORT, MEDIUM or LONG). B The result is cached, see L to refresh the data. =item @reasons = $finder->exclude_file($test) The input argument should be an L instance. This will return a list of human readible reasons a test file should be excluded. If the file should not be excluded the list will be empty. This is a utility method that verifies the file is not in an exclude list/pattern. The reasons are provided back in case you need to inform the user. =item $bool = $finder->include_file($test) The input argument should be an L instance. This is a convenience method around C, it will return true when C returns an empty list. =item $arrayref = $finder->find_multi_project_files($plugins, $settings) =item $arrayref = $finder->find_project_files($plugins, $settings, $search) These do the heavy lifting for C The default C implementation is this: sub find_files { my $self = shift; my ($plugins, $settings) = @_; return $self->find_multi_project_files($plugins, $settings) if $self->multi_project; return $self->find_project_files($plugins, $settings, $self->search); } Each one returns an arrayref of L instances. Note that C uses C internall, once per project directory. $plugins is a list of plugins, some may be class names, others may be instances. $settings is an L instance. $search is an arrayref of search paths. =item $finder->munge_settings($settings, $options) A callback that lets you munge settings and options. =item $finder->pull_durations This will fetch the durations data if ant was provided. This is a hashref of relative test paths as keys where the value is the duration of the file (SHORT, MEDIUM or LONG). L is a cached version of this. This method will refresh the cache for the other. =back =head2 FROM SETTINGS See L for up to date documentation on these. =over 4 =item $finder->default_search =item $finder->default_at_search =item $finder->durations =item $finder->maybe_durations =item $finder->exclude_files =item $finder->exclude_patterns =item $finder->no_long =item $finder->only_long =item $finder->search =item $finder->extensions =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Plugin.pm0000644000175000017500000002316015012417054021241 0ustar exodistexodistpackage Test2::Harness::Plugin; use strict; use warnings; our $VERSION = '1.000158'; # Document, but do not implement #sub changed_files {} #sub changed_diff {} sub munge_search {} sub claim_file {} sub munge_files {} sub inject_run_data {} sub setup {} sub teardown {} sub TO_JSON { ref($_[0]) || "$_[0]" } sub redirect_io { my $this = shift; my ($settings, $name) = @_; my @caller = caller(); my $at = "at $caller[1] line $caller[2].\n"; die "Invalid settings ($settings) $at" unless $settings && ref($settings) eq 'Test2::Harness::Settings'; die "No name provided $at" unless $name; die "This cannot be used without a workspace $at" unless $settings->check_prefix('workspace'); require File::Spec; require Test2::Harness::Util::IPC; my $dir = $settings->workspace->workdir; my $aux = File::Spec->catdir($dir, 'aux_logs'); mkdir($aux) unless -d $aux; Test2::Harness::Util::IPC::swap_io(\*STDOUT, File::Spec->catfile($aux, "${name}-STDOUT.log")); Test2::Harness::Util::IPC::swap_io(\*STDERR, File::Spec->catfile($aux, "${name}-STDERR.log")); return; } sub shellcall { my $this = shift; my ($settings, $name, @cmd) = @_; require POSIX; my @caller = caller(); my $at = "at $caller[1] line $caller[2].\n"; die "Invalid settings ($settings) $at" unless $settings && ref($settings) eq 'Test2::Harness::Settings'; die "No name provided $at" unless $name; die "No command provided $at" unless @cmd && length($cmd[0]); my $pid = fork // die "Could not fork: $!"; if ($pid) { waitpid($pid, 0); return $?; } else { local $@; eval { if ($settings->check_prefix('workspace')) { $this->redirect_io($settings, $name); } exec(@cmd) if @cmd > 1; exec($cmd[0]); }; chomp(my $err = $@ // "unknown error"); warn "Could not run command ($@) $at"; POSIX::_exit(1); } } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Plugin - Base class for Test2::Harness plugins. =head1 DESCRIPTION This class holds the methods specific to L which is the backend. Most of the time you actually want to subclass L which subclasses this class, and holds additional methods that apply to yath (the UI layer). =head1 SYNOPSIS You probably want to subclass L instead. This class here mainly exists to separate concerns, but is not something you should use directly. package Test2::Harness::Plugin::MyPlugin; use parent 'Test2::Harness::Plugin'; # ... Define methods 1; =head1 METHODS =over 4 =item $plugin->munge_search($input, $default_search, $settings) C<$input> is an arrayref of files and/or directories provided at the command line. C<$default_search> is an arrayref with the default files/directories pulled in when nothing is specified at the command ine. C<$settings> is an instance of L =item $undef_or_inst = $plugin->claim_file($path, $settings) This is a chance for a plugin to claim a test file early, before Test2::Harness takes care of it. If your plugin does not want to claim the file just return undef. To claim the file return an instance of L created with C<$path>. =item $plugin->munge_files(\@tests, $settings) This is an opportunity for your plugin to modify the data for any test file that will be run. The first argument is an arrayref of L objects. =item $hashref = $plugin->duration_data($settings, $test_names) If defined, this can return a hashref of duration data. This should return undef if no duration data is provided. The first plugin listed that provides duration data wins, no other plugins will be checked once duration data is obtained. Example duration data: { 't/foo.t' => 'medium', 't/bar.t' => 'short', 't/baz.t' => 'long', } =item $hashref_or_arrayref = $plugin->coverage_data(\@changed) =item $hashref_or_arrayref = $plugin->coverage_data() If defined, this can return a hashref of all coverage data, or an arrayref of tests that cover the tests listed in @changed. This should return undef if no coverage data is available. The first plugin to provide coverage data wins, no other plugins will be checked once coverage data has been obtained. Examples: [ 'foo.t', 'bar.t', 'baz.t', ] { 'lib/Foo.pm' => [ 't/foo.t', 't/integration.t', ], 'lib/Bar.pm' => [ 't/bar.t', 't/integration.t', ], } =item $plugin->post_process_coverage_tests($settings, \@tests) This is an opportunity for a plugin to do post-processing on the list of coverage tests to run. This is mainly useful to remove duplicates if multiple plugins add coverage data, or merging entries where applicable. This will be called after all plugins have generated their coverage test list. Plugins may implement this without implementing coverage_data(), making this useful if you want to use a pre-existing coverage module and want to do post-processing on what it provides. =item $plugin->inject_run_data(meta => $meta, fields => $fields, run => $run) This is a callback that lets your plugin add meta-data or custom fields to the run event. The meta-data and fields are available in the event log, and are particularily useful to L. sub inject_run_data { my $class = shift; my %params = @_; my $meta = $params{meta}; my $fields = $params{fields}; # Meta-data is a hash, each plugin should define its own key, and put # data under that key $meta->{MyPlugin}->{stuff} = "Stuff!"; # Fields is an array of fields that a UI might want to display when showing the run. push @$fields => {name => 'MyPlugin', details => "Human Friendly Stuff", raw => "Less human friendly stuff", data => $all_the_stuff}; return; } =item $plugin->setup($settings) This is a callback that lets you run setup logic when the runner starts. Note that in a persistent runner this is run once on startup, it is not run for each C command against the persistent runner. =item $plugin->teardown($settings) This is a callback that lets you run teardown logic when the runner stops. Note that in a persistent runner this is run once on termination, it is not run for each C command against the persistent runner. =item @files = $plugin->changed_files($settings) Get a list of files that have changed. Plugins are free to define what "changed" means. This may be used by the finder to determine what tests to run based on coverage data collected in previous runs. Note that data from all changed_files() calls from all plugins will be merged. =item ($type, $value) = $plugin->changed_diff($settings) Generate a diff that can be used to calculate changed files/subs for which to run tests. Unlike changed_files(), only 1 diff will be used, first plugin listed that returns one wins. This is not run at all if a diff is provided via --changed-diff. Diffs must be in the same format as this git command: git diff -U1000000 -W --minimal BASE_BRANCH_OR_COMMIT Some other diff formats may work by chance, but they are not dirfectly supported. In the future other diff formats may be directly supported, but not yet. The following return sets are allowed: =over 4 =item file => string Path to a diff file =item diff => string In memory diff as a single string =item lines => \@lines Diff where each line is a seperate string in an arrayref. =item line_sub => sub { ... } Sub that returns one line per call and undef when there are no more lines =item handle => $FH A filehandle to the diff =back =item $exit = $plugin->shellcall($settings, $name, $cmd) =item $exit = $plugin->shellcall($settings, $name, @cmd) This is essentially the same as C except that STDERR and STDOUT are redirected to files that the yath collector will pick up so that any output from the command will be seen as events and will be part of the yath log. If no workspace is available this will not redirect IO and it will be identical to calling C. This is particularily useful in C and C when running external commands, specially any that daemonize and continue to produce output after the setup/teardown method has completed. $name is required because it will be used for filenames, and will be used as the output tag (best to limit it to 8 characters). =item $plugin->redirect_io($settings, $name) B This must NEVER be called in a primary yath process. Only use this in forked processes that you control. If this is used in a main process it could hide ALL output. This will redirect STDERR and STDOUT to files that will be picked up by the yath collector so that any output appears as proper yath events and will be included in the yath log. $name is required because it will be used for filenames, and will be used as the output tag (best to limit it to 8 characters). =item $plugin->TO_JSON This is here as a bare minimum serialization method. It returns the plugin class name. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Event.pm0000644000175000017500000001227315012417054021067 0ustar exodistexodistpackage Test2::Harness::Event; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/confess/; use Time::HiRes qw/time/; use Test2::Harness::Util::JSON qw/encode_json/; use Importer 'Test2::Util::Facets2Legacy' => ':ALL'; BEGIN { require Test2::Event; our @ISA = ('Test2::Event'); # Currently the base class for events does not have init(), that may change if (Test2::Event->can('init')) { *INIT_EVENT = sub() { 1 } } else { *INIT_EVENT = sub() { 0 } } } use Test2::Harness::Util::HashBase qw{ {+FACET_DATA}->{trace} } sub set_trace { confess "'trace' is a read only attribute" } sub init { my $self = shift; $self->Test2::Event::init() if INIT_EVENT; my $data = $self->{+FACET_DATA} || confess "'facet_data' is a required attribute"; for my $field (RUN_ID(), JOB_ID(), JOB_TRY(), EVENT_ID()) { my $v1 = $self->{$field}; my $v2 = $data->{harness}->{$field}; my $d1 = defined($v1); my $d2 = defined($v2); confess "'$field' is a required attribute" unless $d1 || $d2 || ($field eq +JOB_TRY && !$self->{+JOB_ID}); confess "'$field' has different values between attribute and facet data" if $d1 && $d2 && $v1 ne $v2; $self->{$field} = $data->{harness}->{$field} = $v1 // $v2; } delete $data->{facet_data}; # Original trace wins. if (my $trace = delete $self->{+TRACE}) { $self->{+FACET_DATA}->{trace} //= $trace; } } sub as_json { $_[0]->{+JSON} //= encode_json($_[0]) } sub TO_JSON { my $out = {%{$_[0]}}; $out->{+FACET_DATA} = { %{$out->{+FACET_DATA}} }; delete $out->{+FACET_DATA}->{harness_job_watcher}; delete $out->{+FACET_DATA}->{harness}->{closed_by}; delete $out->{+JSON}; delete $out->{+PROCESSED}; return $out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Event - Subclass of Test2::Event used by Test2::Harness under the hood. =head1 DESCRIPTION Test2 tests produce a sequence of events objects L. This is a subclass of those events for use in L. Event non-test tests which produce TAP output will have the output parsed into these types of events. =head1 SYNOPSIS In normal usage ou will never need to create one fo these events yourself. This documentation assumes you are operating on an existing event C<$event> that the harness exposed to you via a plugin or similar. my $facet_data = $event->facet_data; my $run_id = $event->run_id; my $job_id = $event->job_id; my $job_try = $event->job_try; my $event_id = $event->event_id; =head1 METHODS See L for methods provided by the base class. =over 4 =item $hashref = $event->TO_JSON Used for json serialization. =item $json_string = $event->as_json This will return a json representation of the event. Note that this is a lossy conversion with some harness specific state removed by design. This may even be a cached copy of the json string that was decoded to produce the original object. If the string was not cached before it will be cached for all future calls ignoring any state change to the event. The lossy/cached conversion is intended so that events get passed through the harness pipeline without modifications from one step translating to another. If you need something extra to go through you need to either replace the event or create an additional one. =item $string = $event->event_id Usually a UUID, but not always! =item i$hashref = $event->facet_data Get the event facet data, this is the meat of the event that hold all the state. =item $string = $event->job_id Usually a UUID, but not always! =item $int = $event->job_try Integer, 0 or greater. Some jobs are run additional times if they fail, this says which attempt the event is for. The counter starts at 0. =item $bool = $event->processed This will be true if the event has been process by the harness. Note that this attibute is not serialized by C or C. =item $string = $event->run_id The run id. This is usually a UUID, but not always! =item $ts = $event->stamp A unix timestamp for when the event was created. =item $id = $event->stream_id This is an implementation detail of L, do not rely on it. This is used to prevent parsing errors when stream output is nested in other stream output, which can happen if you are writing tests for the stream formatter itself. =item $trace = $event->trace This si a shortcut for C<< $event->facet_data->{trace} >>. The trace data is essential and used everywhere. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Util.pm0000644000175000017500000003356015012417054020725 0ustar exodistexodistpackage Test2::Harness::Util; use strict; use warnings; use Carp qw/confess/; use Cwd qw/realpath/; use Test2::Util qw/try_sig_mask do_rename/; use Fcntl qw/LOCK_EX LOCK_UN SEEK_SET :mode/; use File::Spec; our $VERSION = '1.000158'; use Importer Importer => 'import'; our @EXPORT_OK = qw{ find_libraries clean_path parse_exit mod2file file2mod fqmod maybe_open_file maybe_read_file open_file read_file write_file write_file_atomic lock_file unlock_file hub_truth apply_encoding process_includes chmod_tmp looks_like_uuid is_same_file }; sub is_same_file { my ($file1, $file2) = @_; return 0 unless defined $file1; return 0 unless defined $file2; return 1 if "$file1" eq "$file2"; return 1 if clean_path($file1) eq clean_path($file2); return 0 unless -e $file1; return 0 unless -e $file2; my ($dev1, $inode1) = stat($file1); my ($dev2, $inode2) = stat($file2); return 0 unless $dev1 == $dev2; return 0 unless $inode1 == $inode2; return 1; } sub looks_like_uuid { my ($in) = @_; return undef unless defined $in; return undef unless length($in) == 36; return undef unless $in =~ m/^[0-9A-F\-]+$/i; return $in; } sub chmod_tmp { my $file = shift; my $mode = S_ISVTX | S_IRWXU | S_IRWXG | S_IRWXO; chmod($mode, $file); } sub process_includes { my %params = @_; my @start = @{delete $params{list} // []}; my @list; my %seen = ('.' => 1); if (my $ch_dir = delete $params{ch_dir}) { for my $path (@start) { # '.' is special. $seen{'.'}++ and next if $path eq '.'; if (File::Spec->file_name_is_absolute($path)) { push @list => $path; } else { push @list => File::Spec->catdir($ch_dir, $path); } } } else { @list = @start; } push @list => @INC if delete $params{include_current}; @list = map { $_ eq '.' ? $_ : clean_path($_) || $_ } @list if delete $params{clean}; @list = grep { !$seen{$_}++ } @list; # If we ask for dot, or saw it during our processing, add it to the end. push @list => '.' if delete($params{include_dot}) || $seen{'.'} > 1; confess "Invalid parameters: " . join(', ' => sort keys %params) if keys %params; return @list; } sub apply_encoding { my ($fh, $enc) = @_; return unless $enc; # https://rt.perl.org/Public/Bug/Display.html?id=31923 # If utf8 is requested we use ':utf8' instead of ':encoding(utf8)' in # order to avoid the thread segfault. return binmode($fh, ":utf8") if $enc =~ m/^utf-?8$/i; binmode($fh, ":encoding($enc)"); } sub parse_exit { my ($exit) = @_; my $sig = $exit & 127; my $dmp = $exit & 128; return { sig => $sig, err => ($exit >> 8), dmp => $dmp, all => $exit, }; } sub fqmod { my ($prefix, $input) = @_; return $1 if $input =~ m/^\+(.*)$/; return "$prefix\::$input"; } sub hub_truth { my ($f) = @_; return $f->{hubs}->[0] if $f->{hubs} && @{$f->{hubs}}; return $f->{trace} if $f->{trace}; return {}; } sub maybe_read_file { my ($file) = @_; return undef unless -f $file; return read_file($file); } sub read_file { my ($file, @args) = @_; my $fh = open_file($file, '<', @args); local $/; my $out = <$fh>; close_file($fh, $file); return $out; } sub write_file { my ($file, @content) = @_; my $fh = open_file($file, '>'); print $fh @content; close_file($fh, $file); return @content; }; my %COMPRESSION = ( bz2 => {module => 'IO::Uncompress::Bunzip2', errors => \$IO::Uncompress::Bunzip2::Bunzip2Error}, gz => {module => 'IO::Uncompress::Gunzip', errors => \$IO::Uncompress::Gunzip::GunzipError}, ); sub open_file { my ($file, $mode, %opts) = @_; $mode ||= '<'; unless ($opts{no_decompress}) { if (my $ext = $opts{ext}) { $opts{compression} //= $COMPRESSION{$ext} or die "Unknown compression: $ext"; } if ($file =~ m/\.(gz|bz2)$/i) { my $ext = lc($1); $opts{compression} //= $COMPRESSION{$ext} or die "Unknown compression: $ext"; } if ($mode eq '<' && $opts{compression}) { my $spec = $opts{compression}; my $mod = $spec->{module}; require(mod2file($mod)); my $fh = $mod->new($file) or die "Could not open file '$file' ($mode): ${$spec->{errors}}"; return $fh; } } open(my $fh, $mode, $file) or confess "Could not open file '$file' ($mode): $!"; return $fh; } sub maybe_open_file { my ($file, $mode) = @_; return undef unless -f $file; return open_file($file, $mode); } sub close_file { my ($fh, $name) = @_; return if close($fh); confess "Could not close file: $!" unless $name; confess "Could not close file '$name': $!"; } sub write_file_atomic { my ($file, @content) = @_; my $pend = "$file.pend"; my ($ok, $err) = try_sig_mask { write_file($pend, @content); my ($ren_ok, $ren_err) = do_rename($pend, $file); die "$pend -> $file: $ren_err" unless $ren_ok; }; die $err unless $ok; return @content; } sub lock_file { my ($file, $mode) = @_; my $fh; if (ref $file) { $fh = $file; } else { open($fh, $mode // '>>', $file) or die "Could not open file '$file': $!"; } for (1 .. 21) { flock($fh, LOCK_EX) and last; die "Could not lock file (try $_): $!" if $_ >= 20; next if $!{EINTR} || $!{ERESTART}; die "Could not lock file: $!"; } return $fh; } sub unlock_file { my ($fh) = @_; for (1 .. 21) { flock($fh, LOCK_UN) and last; die "Could not unlock file (try $_): $!" if $_ >= 20; next if $!{EINTR} || $!{ERESTART}; die "Could not unlock file: $!"; } return $fh; } sub clean_path { my ( $path, $absolute ) = @_; $absolute //= 1; $path = realpath($path) // $path if $absolute; return File::Spec->rel2abs($path); } sub mod2file { my ($mod) = @_; confess "No module name provided" unless $mod; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; return $file; } sub file2mod { my $file = shift; my $mod = $file; $mod =~ s{/}{::}g; $mod =~ s/\..*$//; return $mod; } sub find_libraries { my ($search, @paths) = @_; my @parts = grep $_, split /::(\*)?/, $search; @paths = @INC unless @paths; @paths = map { File::Spec->canonpath($_) } @paths; my %prefixes = map {$_ => 1} @paths; my @found; my @bases = ([map { [$_ => length($_)] } @paths]); while (my $set = shift @bases) { my $new_base = []; my $part = shift @parts; for my $base (@$set) { my ($dir, $prefix) = @$base; if ($part ne '*') { my $path = File::Spec->catdir($dir, $part); if (@parts) { push @$new_base => [$path, $prefix] if -d $path; } elsif (-f "$path.pm") { push @found => ["$path.pm", $prefix]; } next; } opendir(my $dh, $dir) or next; for my $item (readdir($dh)) { next if $item =~ m/^\./; my $path = File::Spec->catdir($dir, $item); if (@parts) { # Sometimes @INC dirs are nested in eachother. next if $prefixes{$path}; push @$new_base => [$path, $prefix] if -d $path; next; } next unless -f $path && $path =~ m/\.pm$/; push @found => [$path, $prefix]; } } push @bases => $new_base if @$new_base; } my %out; for my $found (@found) { my ($path, $prefix) = @$found; my @file_parts = File::Spec->splitdir(substr($path, $prefix)); shift @file_parts if $file_parts[0] eq ''; my $file = join '/' => @file_parts; $file_parts[-1] = substr($file_parts[-1], 0, -3); my $module = join '::' => @file_parts; $out{$module} //= $file; } return \%out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util - General utiliy functions. =head1 DESCRIPTION =head1 METHODS =head2 MISC =over 4 =item apply_encoding($fh, $enc) Apply the specified encoding to the filehandle. B: L If utf8 is requested we use ':utf8' instead of ':encoding(utf8)' in order to avoid the thread segfault. This is a reusable implementation of this: sub apply_encoding { my ($fh, $enc) = @_; return unless $enc; return binmode($fh, ":utf8") if $enc =~ m/^utf-?8$/i; binmode($fh, ":encoding($enc)"); } =item $clean = clean_path($path) Take a file path and clean it up to a minimal absolute path if possible. Always returns a path, but if it cannot be cleaned up it is unchanged. =item $hashref = find_libraries($search) =item $hashref = find_libraries($search, @paths) C<@INC> is used if no C<@paths> are provided. C<$search> should be a module name with C<*> wildcards replacing sections. find_libraries('Foo::*::Baz') find_libraries('*::Bar::Baz') find_libraries('Foo::Bar::*') These all look for modules matching the search, this is a good way to find plugins, or similar patterns. The result is a hashref of C<< { $module => $path } >>. If a module exists in more than 1 search path the first is used. =item $mod = fqmod($prefix, $mod) This will automatically add C<$prefix> to C<$mod> with C<'::'> to join them. If C<$mod> starts with the C<'+'> character the character will be removed and the result returned without prepending C<$prefix>. =item hub_truth This is an internal implementation detail, do not use it. =item $hashref = parse_exit($?) This parses the exit value as typically stored in C<$?>. Resulting hash: { sig => ($? & 127), # Signal value if the exit was caused by a signal err => ($? >> 8), # Actual exit code, if any. dmp => ($? & 128), # Was there a core dump? all => $?, # Original exit value, unchanged } =item @list = process_includes(%PARAMS) This method will build up a list of include dirs fit for C<@INC>. The returned list should contain only unique values, in proper order. Params: =over 4 =item list => \@START Paths to start the new list. Optional. =item ch_dir => $path Prefix to prepend to all paths in the C param. No effect without an initial list. =item include_current => $bool This will add all paths from C<@INC> to the output, after the initial list. Note that '.', if in C<@INC> will be moved to the end of the final output. =item clean => $bool If included all paths except C<'.'> will be cleaned using C. =item include_dot => $bool If true C<'.'> will be appended to the end of the output. B even if this is set to false C<'.'> may still be included if it was in the initial list, or if it was in C<@INC> and C<@INC> was included using the C parameter. =back =back =head2 FOR DEALING WITH MODULE <-> FILE CONVERSION These convert between module names like C and filenames like C. =over 4 =item $file = mod2file($mod) =item $mod = file2mod($file) =back =head2 FOR READING/WRITING FILES =over 4 =item $fh = open_file($path, $mode) =item $fh = open_file($path) If no mode is provided C<< '<' >> is assumed. This will open the file at C<$path> and return a filehandle. An exception will be thrown if the file cannot be opened. B This will automatically use L or L to uncompress the file if it has a .bz2 or .gz extension. =item $text = read_file($file) This will open the file at C<$path> and return all its contents. An exception will be thrown if the file cannot be opened. B This will automatically use L or L to uncompress the file if it has a .bz2 or .gz extension. =item $fh = maybe_open_file($path) =item $fh = maybe_open_file($path, $mode) If no mode is provided C<< '<' >> is assumed. This will open the file at C<$path> and return a filehandle. C is returned if the file cannot be opened. B This will automatically use L or L to uncompress the file if it has a .bz2 or .gz extension. =item $text = maybe_read_file($path) This will open the file at C<$path> and return all its contents. This will return C if the file cannot be opened. B This will automatically use L or L to uncompress the file if it has a .bz2 or .gz extension. =item @content = write_file($path, @content) Write content to the specified file. This will open the file with mode C<< '>' >>, write the content, then close the file. An exception will be thrown if any part fails. =item @content = write_file_atomic($path, @content) This will open a temporary file, write the content, close the file, then rename the file to the desired C<$path>. This is essentially an atomic write in that C<$file> will not exist until all content is written, preventing other processes from doing a partial read while C<@content> is being written. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Run.pm0000644000175000017500000000525615012417054020555 0ustar exodistexodistpackage Test2::Harness::Run; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak/; use File::Spec; use Test2::Harness::Util::HashBase qw{ {+RUN_ID}; } sub run_dir { my $self = shift; my ($workdir) = @_; return File::Spec->catfile($workdir, $self->{+RUN_ID}); } sub TO_JSON { +{ %{$_[0]} } } sub queue_item { my $self = shift; my ($plugins) = @_; croak "a plugins arrayref is required" unless $plugins; my $out = {%$self}; my $meta = $out->{+META} //= {}; my $fields = $out->{+FIELDS} //= []; for my $p (@$plugins) { $p->inject_run_data(meta => $meta, fields => $fields, run => $self); } return $out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Run - Representation of a set of tests to run, and their options. =head1 DESCRIPTION =head1 ATTRIBUTES These are set at construction time and cannot be modified. See L for more documentation on these. =head2 FROM OPTIONS =over 4 =item $bool = $run->author_testing =item $hashref = $run->env_vars =item $bool = $run->event_uuids =item $arrayref = $run->fields =item $string = $run->input =item $path = $run->input_file =item $bool = $run->io_events =item $arrayref = $run->links =item $arrayref = $run->load =item $hashref = $run->load_import =item $bool = $run->mem_usage =item $int = $run->retry =item $bool = $run->retry_isolated =item $string = $run->run_id =item $arrayref = $run->test_args =item $bool = $run->unsafe_inc =item $bool = $run->use_stream =back =head2 OTHER =over 4 =item $hashref = $run->meta meta-data plugins may have attached. =back =head1 METHODS =over 4 =item $path = $run->run_dir($workdir) Returns the path C<"$workdir/$run_id">. =item $hashref = $run->queue_item(\@PLUGINS) Gets the queue item that represents this object. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/Log.pm0000644000175000017500000001764515012417054020537 0ustar exodistexodistpackage Test2::Harness::Log; use strict; use warnings; our $VERSION = '1.000158'; 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Log - Documentation about the L log file. =head1 DESCRIPTION L aka L produces a rich/complete log when asked to do so. This module documents the log format. =head1 COMPRESSION Test2::Harness can output log files uncompressed, compressed in gzip, or compressed in bzip2. =head1 FORMAT The log file is in jsonl format. Each line of the log can be indepentantly parsed as json. Each line represents a single event Test2::Harness processed during a run. These events will be in the original order Test2::Harness processed them in (may not be chronological to when they were generated as generation, collection, processing, and rendering are handled in different processes. A complete log will be terminated by the string C, which is also valid json. If a log is missing this terminator it is considered an incomplete log. =head2 EVENTS B Older versions of Test2::Harness produced less complete events, this covers all current fields, if you are attempting to handle very old logs some of these fields may be missing. Each event will have the following fields: { "event_id" : "CD01CD30-D535-11EA-9B6A-D90F9664FE12", "job_id" : 0, "job_try" : null, "run_id" : "CCF98E54-D535-11EA-915A-D70F9664FE12", "stamp" : 1596423763.76517, "facet_data" : { "harness" : { "event_id" : "CD01CD30-D535-11EA-9B6A-D90F9664FE12", "job_id" : 0, "job_try" : null, "run_id" : "CCF98E54-D535-11EA-915A-D70F9664FE12" }, ... } } =over 4 =item event_id : "UUID_OR_STRING" Typically this will be a UUID, but when UUIDs cannot be generated it may have a different unique identifier. This will always be a string. This may never be NULL, if it is NULL then that is a bug and should be reported. =item job_id : "0_OR_UUID_OR_STRING" ID C<0> is special in that it represents the test harness itself, and not an actual test being run. Normally the job_id will be a UUID, but may be another unique string if UUID generation is disabled or not available. =item job_try : INTEGER_OR_NULL For C<< job_id => 0 >> this will be C for any other job this will be an intgeger of 0 or greater. This is 0 for the first time a test job is run, if a job is re-run due to failure (or any other reason) this will be incremented to tell you what run it is. When a job is re-run it keeps the same job ID, you can use this to distinguish events from each run of the job. =item run_id : "UUID_OR_STRING" This is the run_id of the entire yath test run. This should be the same for every event in any given log. =item stamp : UNIX_TIME_STAMP Timestamp of the event. This is NORMALLY set when an event is generated, however if an event does not have its own time stamp yath will give it a timestamp upon collection. Events without timestamps happen if the test outputs TAP instead of L objects, or if a tool misbehaves in some way. =item facet_data : HASH This contains all the the data of the event, such as if an assertion was made, what file name and line number generated it, etc. In addition to the original facets of the event, Test2::Harness may inject the following facets (or generate completely new events to convey these facets). =over 4 =item harness_final This will contain the final summary data from the end of the test run. { # Was the test run a success, or were there failures? pass => $BOOL, # What tests failed? failed => [ [ $job_id, # Job id of the job that failed $file, # Test filename ], ... ], # What tests had to be retried, and did they eventually pass? retried => [ [ $job_id, # Job id of the job that was retied $tries, # Number of tries attempted $file, # Test filename $eventually_passed, # 'YES' if it eventually passed, 'NO' if no try ever passed. ], ... ], # What tests setn a halt event (such as bail-out, or skip the rest) halted => [ [ $job_id, # Job id of the test $file, # Test filename $halt, # Halt code ], ... ], # What tests were never run (maybe because of a bail-out, or an internal error) unseen => [ [ $job_id, # Job id of the test $file, # Test filename ], ... ], } =item harness_watcher Internal use only, subject to change, do not rely on it. =item harness_job A hash representation of an L object. B This is done via a transformation, several methods have their values stored in this hash when the original object does not directly store them. =item harness_job_end { file => $provided_path_to_test_file, rel_file => $relative_path_to_test_file, abs_file => $absolute_path_to_test_file, fail => $BOOL, retry => $INTEGER, # Number of retries left stamp => $UNIX_TIMESTAMP, # Timestamp of when the test completed # May not be present skip => $STRING, # Reason test was skipped (if it was skipped) times => $TIMING_DATA, # See below } The C field is populated by calling C on an L Object. =item harness_job_exit This represents when the test job exited. { exit => $WSTAT, retry => $INTEGER stamp => $UNIX_TIMESTAMP } =item harness_job_fields Extra data attached to the harness job, usually from an L via C. =item harness_job_launch This facet is almost always in the same event as the C facet. I While writing these docs the author wonders if this facet is unnecessary... { stamp => $UNIX_TIMESTAMP, rety => $INTEGER, } =item harness_job_queued This data is produced by the C method in L. This contains the data about a test job conveyed by the queue. This usually contains data that will later be used by L. It is better to use the C facet, which contains the final data used to run the job. The following 3 fields are the only ones likely to be useful to most people: { file => $ORIGINAL_PATH_TO_FILE, job_id => $UUID_OR_STRING, stamp => $UNIX_TIMESTAMP, } =item harness_job_start This facet is sent in an event as soon as a job starts. The data in this facet is mainly intended to convey necessary information to a renderer so that it can render the fact that a job started. { file => $provided_path_to_test_file, rel_file => $relative_path_to_test_file, abs_file => $absolute_path_to_test_file, stamp => $UNIX_TIMESTAMP, # Timestamp of when the test completed job_id => $UUID_OR_STRING, details => "Job UUID_OR_STRING started at $UNIX_TIMESTAMP", } =item harness_run A hash representation of an L object. =back =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness/IPC.pm0000644000175000017500000002540615012417054020423 0ustar exodistexodistpackage Test2::Harness::IPC; use strict; use warnings; our $VERSION = '1.000158'; use POSIX; use Config qw/%Config/; use Carp qw/croak confess/; use Time::HiRes qw/sleep time/; use Test2::Harness::Util::IPC qw/run_cmd USE_P_GROUPS/; use Test2::Harness::IPC::Process; BEGIN { my %SIG_MAP; my @SIGNAMES = split /\s+/, $Config{sig_name}; my @SIGNUMS = split /\s+/, $Config{sig_num}; while (@SIGNAMES) { $SIG_MAP{shift(@SIGNAMES)} = shift @SIGNUMS; } *SIG_MAP = sub() { \%SIG_MAP }; } use Test2::Harness::Util::HashBase qw{ {+PID} = $$; $self->{+PROCS} //= {}; $self->{+PROCS_BY_CAT} //= {}; $self->{+WAIT_TIME} = 0.02 unless defined $self->{+WAIT_TIME}; $self->{+HANDLERS} //= {}; $self->{+HANDLERS}->{CHLD} //= sub { 1 }; $self->{+SIG_COUNT} //= 0; } sub start { my $self = shift; my @caller = caller(1); return if $self->{+STARTED}; $self->{+STARTED} = 1; $self->check_for_fork(); for my $sig (qw/INT HUP TERM CHLD/) { croak "Signal '$sig' was already set by something else" if defined $SIG{$sig} && $SIG{$sig} ne 'IGNORE' && $SIG{$sig} ne 'DEFAULT'; $SIG{$sig} = sub { $self->handle_sig($sig) }; } } sub stop { my $self = shift; $self->wait(all => 1); delete $SIG{$_} for qw/INT HUP TERM CHLD/; $self->{+STARTED} = 0; } sub set_sig_handler { my $self = shift; my ($sig, $sub) = @_; $self->{+HANDLERS}->{$sig} = $sub; } sub handle_sig { my $self = shift; my ($sig) = @_; $self->{+SIG_COUNT}++ unless $sig eq 'CHLD'; return $self->{+HANDLERS}->{$sig}->($sig) if $self->{+HANDLERS}->{$sig}; $self->stop(); exit(SIG_MAP->{$sig}); } sub killall { my $self = shift; my ($sig) = @_; $sig //= 'TERM'; $self->check_for_fork(); kill($sig, keys %{$self->{+PROCS}}); } sub check_timeouts {} sub check_for_fork { my $self = shift; return 0 if $self->{+PID} == $$; $self->{+PROCS} = {}; $self->{+PROCS_BY_CAT} = {}; $self->{+WAITING} = {}; $self->{+PID} = $$; return 1; } sub _bring_out_yer_dead { my $self = shift; my $procs = $self->{+PROCS} //= {}; my $waiting = $self->{+WAITING} //= {}; # Wait on any/all pids my $found = 0; while ((my $pid = waitpid(-1, WNOHANG)) > 0) { my $exit = $?; die "waitpid returned pid '$pid', but we are not monitoring that one!" unless $procs->{$pid}; $found++; $waiting->{$pid} = [$exit, time()]; } return $found; } sub _check_if_dead_yet { my $self = shift; my $procs = $self->{+PROCS} //= {}; my $cat_procs = $self->{+PROCS_BY_CAT} //= {}; my $waiting = $self->{+WAITING} //= {}; my $found = 0; for my $pid (keys %$waiting) { next if USE_P_GROUPS && kill(0, -$pid); $found++; my $args = delete $waiting->{$pid}; my $proc = delete $procs->{$pid}; delete $cat_procs->{$proc->category}->{$pid}; $self->set_proc_exit($proc, @$args); } return $found; } sub set_proc_exit { my $self = shift; my ($proc, @args) = @_; $proc->set_exit($self, @args); } sub _ex_parrots { my $self = shift; my $procs = $self->{+PROCS} //= {}; my $cat_procs = $self->{+PROCS_BY_CAT} //= {}; my $waiting = $self->{+WAITING} //= {}; my $found = 0; for my $pid (keys %$procs) { next if $waiting->{$pid}; next if kill(0, $pid); $found++; warn "Process $pid vanished!"; $waiting->{$pid} = [-1, time()]; } return $found; } sub wait { my $self = shift; my %params = @_; $self->check_for_fork(); my $sig_count = $self->{+SIG_COUNT}; my $procs = $self->{+PROCS} //= {}; my $cat_procs = $self->{+PROCS_BY_CAT} //= {}; my $waiting = $self->{+WAITING} //= {}; return 0 unless keys(%$procs) || keys(%$waiting); my $cat_total = $params{cat} ? keys %{$cat_procs->{$params{cat}}} : 0; my $start = time; my $count = 0; my $found = 0; while (1) { $self->check_timeouts; $found += $self->_bring_out_yer_dead(); $found += $self->_check_if_dead_yet(); return $found if $self->_wait_done($found, $start, \%params); if (my $cat = $params{cat}) { my $cur_total = keys %{$cat_procs->{$cat}}; return 0 unless $cur_total; my $delta = $cat_total - $cur_total; return $delta if $delta; } # This is expensive, so only do it if we are gonna end up waiting # anyway If we do find anything here do not bother waiting. next if $self->_ex_parrots(); # Break the loop if we had a signal come in since starting last if $self->{+SIG_COUNT} > $sig_count; sleep($self->{+WAIT_TIME}) if $self->{+WAIT_TIME}; } warn "We escaped the wait cycle"; return $found; } sub _wait_done { my $self = shift; my ($found, $start, $params) = @_; my $all = keys(%{$self->{+PROCS}}); return 1 unless $all; return 1 if $params->{timeout} && time - $start >= $params->{timeout}; return 0 if $all && $params->{all}; return 0 if $params->{all_cat} && keys %{$self->{+PROCS_BY_CAT}->{$params->{all_cat}}}; return 0 if $params->{block} && !$found; # This gets validated outside this loop return 0 if $params->{cat}; return 1; } sub watch_pid { my $self = shift; my ($pid) = @_; my $proc = Test2::Harness::IPC::Process->new(pid => $pid); return $self->watch($proc); } sub watch { my $self = shift; my ($proc) = @_; $self->check_for_fork(); my $pid = $proc->pid or confess "Process has no pid"; $pid = abs($pid) if USE_P_GROUPS; croak "Already watching pid $pid" if exists $self->{+PROCS}->{$pid}; $self->{+PROCS}->{$pid} = $proc; $self->{+PROCS_BY_CAT}->{$proc->category}->{$pid} = $proc; } sub spawn { my $self = shift; my ($proc, $params); if (@_ == 1) { $proc = shift(@_); $params = $proc->spawn_params; } else { $params = {@_}; my $class = $params->{process_class} // 'Test2::Harness::IPC::Process'; $proc = $class->new(); } croak "No 'command' specified" unless $params->{command}; my $caller1 = [caller()]; my $caller2 = [caller(1)]; my $env = $params->{env_vars} // {}; $self->check_for_fork(); my $pid = run_cmd(env => $env, caller1 => $caller1, caller2 => $caller2, %$params); $proc->set_pid($pid); $self->watch($proc); return $proc; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::IPC - Base class for modules that control child processes. =head1 DESCRIPTION This module is the base class for all parts of L that have to do process management. =head1 ATTRIBUTES =over 4 =item $pid = $ipc->pid The root PID of the IPC object. =item $hashref = $ipc->handlers Custom signal handlers specific to the IPC object. =item $hashref = $ipc->procs Hashref of C<< $pid => $proc >> where $proc is an instance of L. =item $hashref = $ipc->procs_by_cat Hashref of C<< $category => { $pid => $proc } >>. =item $hashref = $ipc->waiting Hashref of processes that have finished, but have not been handled yet. This is an implementation detail you should not rely on. =item $float = $ipc->wait_time How long to sleep between loops when in a wait cycle. =item $bool = $ipc->started True if the IPC process has started. =item $ipc->sig_count Implementation detail, used to break wait loops when signals are received. =back =head1 METHODS =over 4 =item $ipc->start Start the IPC management (Insert signal handlers). =item $ipc->stop Stop the IPC management (Remove signal handlers). =item $ipc->set_sig_handler($sig, sub { ... }) Set a custom signal handler. This is a safer version of C<< local %SIG{$sig} >> for use with IPC. The callback will get exactly one argument, the name of the signal that was recieved. =item $ipc->handle_sig($sig) Handle the specified signal. Will cause process exit if the signal has no handler. =item $ipc->killall() =item $ipc->killall($sig) Kill all tracked child process with the given signal. C is used if no signal is specified. This will not wait on the processes, you must call C<< $ipc->wait() >>. =item $ipc->check_timeouts This is a no-op on the IPC base class. This is called every loop of C<< $ipc->wait >>. If you subclass the IPC class you can fill this in to make processes timeout if needed. =item $ipc->check_for_fork This is used a lot internally to check if this is a forked process. If this is a forked process the IPC object is completely reset with no remaining internal state (except signal handlers). =item $ipc->set_proc_exit($proc, @args) Calls C<< $proc->set_exit(@args) >>. This is called by C<< $ipc->wait >>. You can override it to add custom tasks when a process exits. =item $int = $ipc->wait() =item $int = $ipc->wait(%params) Wait on processes, return the number found. Default is non-blocking. Options: =over 4 =item timeout => $float If a blocking paremeter is provided this can be used to break the wait after a timeout. L is used, so timeout is in seconds with decimals. =item all => $bool Block until B processes are done. =item cat => $category Block until at least 1 process from the category is complete. =item all_cat => $category Block until B processes from the category are complete. =item block => $bool Block until at least 1 process is complete. =back =item $ipc->watch($proc) Add a process to be monitored. =item $proc = $ipc->spawn($proc) =item $proc = $ipc->spawn(%params) In the first form $proc is an instance of L that provides C. In the second form the following params are allowed: Anything supported by C in L. =over 4 =item process_class => $CLASS Default is L. =item command => $command Program command to call. This is required. =item env_vars => { ... } Specify custom environment variables for the new process. =back =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/Test2/Harness.pm0000644000175000017500000000203015012417054017774 0ustar exodistexodistpackage Test2::Harness; use strict; use warnings; our $VERSION = '1.000158'; 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness - A new and improved test harness with better L integration. =head1 DESCRIPTION Test2::Harness is the backend code that handles running/processing the tests. In general a user will not use it directly, instead you should probably be looking at L which is the UI layer built around Test2::Harness. =head1 SEE ALSO The primary documentation can be found in L. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/0000755000175000017500000000000015012417054015557 5ustar exodistexodistTest2-Harness-1.000158/lib/App/Yath/0000755000175000017500000000000015012417054016464 5ustar exodistexodistTest2-Harness-1.000158/lib/App/Yath/Options/0000755000175000017500000000000015012417054020117 5ustar exodistexodistTest2-Harness-1.000158/lib/App/Yath/Options/PreCommand.pm0000644000175000017500000001554415012417054022513 0ustar exodistexodistpackage App::Yath::Options::PreCommand; use strict; use warnings; our $VERSION = '1.000158'; use App::Yath::Util qw/find_pfile/; use Test2::Harness::Util qw/mod2file clean_path/; use App::Yath::Options; option_group {prefix => 'harness', pre_command => 1} => sub { option plugins => ( type => 'm', short => 'p', alt => ['plugin'], category => 'Plugins', long_examples => [' PLUGIN', ' +App::Yath::Plugin::PLUGIN', ' PLUGIN=arg1,arg2,...'], short_examples => ['PLUGIN'], description => 'Load a yath plugin.', action => \&plugin_action, ); option no_scan_plugins => ( type => 'b', category => 'Plugins', description => 'Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not.', ); option project => ( type => 's', alt => ['project-name'], category => 'Environment', description => 'This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner.', ); option persist_dir => ( type => 's', category => 'Environment', description => 'Where to find persistence files.', normalize => \&clean_path, ); option persist_file => ( type => 's', category => 'Environment', alt => ['pfile'], normalize => \&clean_path, description => "Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system.", ); option dev_libs => ( type => 'D', short => 'D', name => 'dev-lib', category => 'Developer', description => 'Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch.', long_examples => ['', '=lib'], short_examples => ['', '=lib', 'lib'], normalize => \&normalize_dev_libs, action => \&dev_libs_action, ); post \&post_process; }; sub plugin_action { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler, $options) = @_; my ($class, $args) = split /=/, $norm, 2; $args = [split ',', $args] if $args; $class = "App::Yath::Plugin::$class" unless $class =~ s/^\+//; return if grep { $class eq (ref($_) || $_) } @{$settings->harness->plugins}; my $file = mod2file($class); require $file; $options->include_from($class) if $class->can('options'); my $plugin = $class->can('new') ? $class->new(@{$args // []}) : $class; $handler->($slot, $plugin); } sub normalize_dev_libs { my $val = shift; return $val if $val eq '1'; return clean_path($val); } sub dev_libs_action { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; my %seen = map { $_ => 1 } @{$$slot}; my @new = grep { !$seen{$_}++ } ($norm eq '1') ? (map { clean_path($_) } 'lib', 'blib/lib', 'blib/arch') : ($norm); return unless @new; warn <<" EOT" for @new; dev-lib '$_' added to \@INC late, it is possible some yath libraries were already loaded from other paths. (Maybe you need to move the -D or --dev-lib argument(s) to be earlier in your command line or config file?) EOT unshift @INC => @new; unshift @{$$slot} => @new; } sub post_process { my %params = @_; my $settings = $params{settings}; $settings->harness->field(persist_file => find_pfile($settings, vivify => 1, no_checks => 1)) unless defined $settings->harness->persist_file; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::PreCommand - Options for yath before command is specified. =head1 DESCRIPTION This is qhere many pe-commnd options are defined. =head1 PROVIDED OPTIONS =head2 YATH OPTIONS (PRE-COMMAND) =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Options/Workspace.pm0000644000175000017500000000656615012417054022430 0ustar exodistexodistpackage App::Yath::Options::Workspace; use strict; use warnings; our $VERSION = '1.000158'; use File::Spec(); use File::Path qw/remove_tree/; use File::Temp qw/tempdir/; use Test2::Harness::Util qw/clean_path chmod_tmp/; use App::Yath::Options; option_group {prefix => 'workspace', category => "Workspace Options"} => sub { option tmp_dir => ( type => 's', short => 't', alt => ['tmpdir'], description => 'Use a specific temp directory (Default: use system temp dir)', env_vars => [qw/T2_HARNESS_TEMP_DIR YATH_TEMP_DIR TMPDIR TEMPDIR TMP_DIR TEMP_DIR/], default => sub { File::Spec->tmpdir }, ); option workdir => ( type => 's', short => 'w', description => 'Set the work directory (Default: new temp directory)', env_vars => [qw/T2_WORKDIR YATH_WORKDIR/], clear_env_vars => 1, normalize => \&clean_path, ); option clear => ( short => 'C', description => 'Clear the work directory if it is not already empty', ); post sub { my %params = @_; my $settings = $params{settings}; if (my $workdir = $settings->workspace->workdir) { if (-d $workdir) { remove_tree($workdir, {safe => 1, keep_root => 1}) if $settings->workspace->clear; } else { mkdir($workdir) or die "Could not create workdir: $!"; chmod_tmp($workdir); } return; } my $project = $settings->harness->project; my $template = join '-' => ( "yath", $$, "XXXXXX"); my $tmpdir = tempdir( $template, DIR => $settings->workspace->tmp_dir, CLEANUP => !($settings->debug->keep_dirs || $params{command}->always_keep_dir), ); chmod_tmp($tmpdir); $settings->workspace->field(workdir => $tmpdir); }; }; 1; =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Workspace - Options for specifying the yath work dir. =head1 DESCRIPTION Options regarding the yath working directory. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Workspace Options =over 4 =item --clear =item -C =item --no-clear Clear the work directory if it is not already empty =item --tmp-dir ARG =item --tmp-dir=ARG =item --tmpdir ARG =item --tmpdir=ARG =item -t ARG =item -t=ARG =item --no-tmp-dir Use a specific temp directory (Default: use system temp dir) Can also be set with the following environment variables: C, C, C, C, C, C =item --workdir ARG =item --workdir=ARG =item -w ARG =item -w=ARG =item --no-workdir Set the work directory (Default: new temp directory) Can also be set with the following environment variables: C, C =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Options/Collector.pm0000644000175000017500000000444315012417054022410 0ustar exodistexodistpackage App::Yath::Options::Collector; use strict; use warnings; our $VERSION = '1.000158'; use App::Yath::Options; option_group {prefix => 'collector', category => "Collector Options"} => sub { option max_open_jobs => ( type => 's', description => 'Maximum number of jobs a collector can process at a time, if more jobs are pending their output will be delayed until the earlier jobs have been processed. (Default: double the -j value)', long_examples => [' 18'], short_examples => [' 18'], ); option max_poll_events => ( type => 's', description => 'Maximum number of events to poll from a job before jumping to the next job. (Default: 1000)', default => 1000, long_examples => [' 1000'], short_examples => [' 1000'], ); post \&collector_post; }; sub collector_post { my %params = @_; my $settings = $params{settings}; unless ($settings->collector->max_open_jobs) { my $j = $settings->runner->job_count // 1; my $max_open = 2 * $j; $settings->collector->field(max_open_jobs => $max_open); } } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Collector - collector options for Yath. =head1 DESCRIPTION This is where the command line options for the collector are defined. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Collector Options =over 4 =item --max-open-jobs 18 =item --no-max-open-jobs Maximum number of jobs a collector can process at a time, if more jobs are pending their output will be delayed until the earlier jobs have been processed. (Default: double the -j value) =item --max-poll-events 1000 =item --no-max-poll-events Maximum number of events to poll from a job before jumping to the next job. (Default: 1000) =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Options/Persist.pm0000644000175000017500000000241015012417054022103 0ustar exodistexodistpackage App::Yath::Options::Persist; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Util qw/IS_WIN32/; use Test2::Harness::Util qw/clean_path/; use App::Yath::Options; option_group {prefix => 'runner', category => "Runner Options"} => sub { option daemon => ( description => 'Start the runner as a daemon (Default: True)', default => 1, ); }; 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Persist - Persistent Runner options for Yath. =head1 DESCRIPTION This is where the command line options for the persistent runner are defined. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Runner Options =over 4 =item --daemon =item --no-daemon Start the runner as a daemon (Default: True) =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Options/Logging.pm0000644000175000017500000001460215012417054022046 0ustar exodistexodistpackage App::Yath::Options::Logging; use strict; use warnings; our $VERSION = '1.000158'; use POSIX qw/strftime/; use Test2::Harness::Util qw/clean_path/; use File::Spec; use App::Yath::Options; option_group {prefix => 'logging', category => "Logging Options"} => sub { option log => ( short => 'L', description => 'Turn on logging', ); option log_file_format => ( alt => ['lff'], type => 's', env_vars => [qw/YATH_LOG_FILE_FORMAT TEST2_HARNESS_LOG_FORMAT/], default => sub { '%!P%Y-%m-%d_%H:%M:%S_%!U.jsonl' }, description => 'Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC)', ); option bzip2 => ( short => 'B', alt => ['bz2', 'bzip2_log'], description => 'Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you', ); option gzip => ( short => 'G', alt => ['gz', 'gzip_log'], description => 'Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you', ); option log_dir => ( type => 's', normalize => \&clean_path, description => 'Specify a log directory. Will fall back to the system temp dir.', ); option log_file => ( short => 'F', type => 's', normalize => \&clean_path, description => "Specify the name of the log file. This option implies -L.", ); post \&post_process; }; sub post_process { my %params = @_; my $settings = $params{settings}; my $logging = $settings->logging; die "You cannot specify both bzip2-log and gzip-log\n" if $logging->bzip2 && $logging->gzip; return unless $logging->log || $logging->bzip2 || $logging->gzip || $logging->log_file; # We want to keep the log and put it in a findable location $logging->field(log => 1); unless ($logging->log_file) { my $log_dir = $logging->log_dir // ($settings->check_prefix('workspace') ? $settings->workspace->tmp_dir : File::Spec->tmpdir); mkdir($log_dir) or die "Could not create dir '$log_dir': $!" unless -d $log_dir; my $format = $logging->log_file_format; my $filename = expand_log_file_format($format, $settings); $logging->field(log_file => clean_path(File::Spec->catfile($log_dir, $filename))); } my $log_file = $logging->log_file; $log_file =~ s{/+$}{}g; $log_file =~ s/\.(gz|bz2)$//; $log_file =~ s/\.jsonl?$//; $log_file .= "\.jsonl"; $log_file .= "\.bz2" if $logging->bzip2; $log_file .= "\.gz" if $logging->gzip; $logging->field(log_file => $log_file); } sub time_for_strftime { time() } sub expand_log_file_format { my ($pattern, $settings) = @_; my $before = $pattern; $pattern =~ s{%!(\w)}{expand($1, $settings)}ge; my $res = strftime($pattern, localtime(time_for_strftime())); return $res; } sub expand { my ($letter, $settings) = @_; # This could be driven by a hash, but for now if-else is easiest if ($letter eq "U") { return $settings->run->run_id } elsif ($letter eq "p") { return $$ } elsif ($letter eq "P") { my $project = $settings->harness->project // return ""; return $project . "~"; } elsif ($letter eq "S") { # Number of seconds since midnight my ($s, $m, $h) = (localtime(time_for_strftime()))[0, 1, 2]; return sprintf("%05d", $s + 60 * $m + 3600 * $h); } else { # unrecognized `%!x` expansion. Should we warn? Die? return "%!$letter"; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Logging - Logging options for yath =head1 DESCRIPTION This is where the command line options for logging are defined. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C, C =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Options/Display.pm0000644000175000017500000002214615012417054022067 0ustar exodistexodistpackage App::Yath::Options::Display; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Harness::Util qw/mod2file/; use App::Yath::Options; option_group {prefix => 'display', category => "Display Options"} => sub { option color => ( description => "Turn color on, default is true if STDOUT is a TTY.", default => sub { -t STDOUT ? 1 : 0 }, ); option quiet => ( short => 'q', type => 'c', description => "Be very quiet.", default => 0, ); option verbose => ( short => 'v', type => 'c', description => "Be more verbose", default => 0, ); option no_wrap => ( type => 'b', description => "Do not do fancy text-wrapping, let the terminal handle it", default => 0, ); option show_times => ( short => 'T', description => 'Show the timing data for each job', ); option hide_runner_output => ( description => 'Hide output from the runner, showing only test output. (See Also truncate_runner_output)', default => 0, ); option truncate_runner_output => ( description => 'Only show runner output that was generated after the current command. This is only useful with a persistent runner.', default => 0, ); option term_width => ( type => 's', alt => ['term-size'], description => 'Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified.', long_examples => [' 80', ' 200'], action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; $ENV{TABLE_TERM_SIZE} = $norm; }, ); option 'progress' => ( default => sub { -t STDOUT ? 1 : 0 }, description => "Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display", ); option renderers => ( alt => ['renderer'], type => 'H', description => 'Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument.', long_examples => [' +My::Renderer', ' Renderer=arg1,arg2,...'], short_examples => [' +My::Renderer', ' Renderer=arg1,arg2,...'], action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; my ($class, $args) = @$norm; $class = "Test2::Harness::Renderer::$class" unless $class =~ s/^\+//; my $file = mod2file($class); my $ok = eval { require $file; 1 }; warn "Failed to load renderer '$class': $@" unless $ok; $handler->($slot, [$class, $args]); }, ); post 100 => sub { my %params = @_; my $settings = $params{settings}; my $display = $settings->display; my $renderers = $display->renderers; my $quiet = $display->quiet; my $verbose = $display->verbose; die "The 'quiet' and 'verbose' options may not be used together.\n" if $verbose && $quiet; if ($quiet) { delete $renderers->{'Test2::Harness::Renderer::Formatter'}; @{$renderers->{'@'}} = grep { $_ ne 'Test2::Harness::Renderer::Formatter' } @{$renderers->{'@'}}; return; } my @args = map { $_ => $settings->formatter->$_ } qw{ formatter show_run_info show_job_info show_job_launch show_job_end }; push @args => map { $_ => $settings->display->$_ } qw{ progress color quiet verbose show_times }; if (my $formatter_args = $renderers->{'Test2::Harness::Renderer::Formatter'}) { @$formatter_args = @args unless @$formatter_args; return; } return if $renderers->{'@'} && @{$renderers->{'@'}}; push @{$renderers->{'@'}} => 'Test2::Harness::Renderer::Formatter'; $renderers->{'Test2::Harness::Renderer::Formatter'} = \@args; }; }; option_group {prefix => 'formatter', category => "Formatter Options"} => sub { option formatter => ( type => 's', ); option 'qvf' => ( description => '[Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output.', ); option show_job_end => ( description => 'Show output when a job ends. (Default: on)', default => 1, ); option show_job_info => ( description => 'Show the job configuration when a job starts. (Default: off, unless -vv)', default => 0, ); option show_job_launch => ( description => "Show output for the start of a job. (Default: off unless -v)", default => 0, ); option show_run_info => ( description => 'Show the run configuration when a run starts. (Default: off, unless -vv)', default => 0, ); post 90 => sub { my %params = @_; my $settings = $params{settings}; $settings->formatter->field(formatter => $settings->formatter->qvf ? 'QVF' : 'Test2') unless defined $settings->formatter->formatter; $settings->formatter->field(show_job_launch => 1) if $settings->display->verbose > 0; if ($settings->display->verbose > 1) { $settings->formatter->field(show_job_info => 1); $settings->formatter->field(show_run_info => 1); } }; }; 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Display - Display options for Yath. =head1 DESCRIPTION This is where display options are defined. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Options/Runner.pm0000644000175000017500000004266315012417054021741 0ustar exodistexodistpackage App::Yath::Options::Runner; use strict; use warnings; our $VERSION = '1.000158'; use List::Util qw/min/; use Test2::Util qw/IS_WIN32/; use App::Yath::Util qw/find_in_updir/; use Test2::Harness::Util qw/clean_path mod2file/; use Test2::Harness::Util::UUID qw/gen_uuid/; use File::Spec; use App::Yath::Options; my $DEFAULT_COVER_ARGS = '-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl'; option_group {prefix => 'runner', category => "Runner Options"} => sub { option use_fork => ( alt => ['fork'], description => "(default: on, except on windows) Normally tests are run by forking, which allows for features like preloading. This will turn off the behavior globally (which is not compatible with preloading). This is slower, it is better to tag misbehaving tests with the '# HARNESS-NO-PRELOAD' comment in their header to disable forking only for those tests.", env_vars => [qw/!T2_NO_FORK T2_HARNESS_FORK !T2_HARNESS_NO_FORK YATH_FORK !YATH_NO_FORK/], default => sub { return 0 if IS_WIN32; return 1; }, ); option abort_on_bail => ( type => 'b', default => 1, description => "Abort all testing if a bail-out is encountered (default: on)", ); option use_timeout => ( alt => ['timeout'], description => "(default: on) Enable/disable timeouts", default => 1, ); option shared_jobs_config => ( type => 's', description => 'Where to look for a shared slot config file. If a filename with no path is provided yath will search the current and all parent directories for the name.', default => '.sharedjobslots.yml', long_examples => [ ' .sharedjobslots.yml', ' relative/path/.sharedjobslots.yml', ' /absolute/path/.sharedjobslots.yml' ], ); post \&jobs_post_process; option job_count => ( type => 's', short => 'j', alt => ['jobs'], description => 'Set the number of concurrent jobs to run. Add a :# if you also wish to designate multiple slots per test. 8:2 means 8 slots, but each test gets 2 slots, so 4 tests run concurrently. Tests can find their concurrency assignemnt in the "T2_HARNESS_MY_JOB_CONCURRENCY" environment variable.', env_vars => [qw/YATH_JOB_COUNT T2_HARNESS_JOB_COUNT HARNESS_JOB_COUNT/], clear_env_vars => 1, long_examples => [' 4', ' 8:2'], short_examples => ['4', '8:2'], action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; my ($jobs, $slots) = split /:/, $norm; $$slot = $jobs; $settings->runner->slots_per_job($slots) if defined $slots; fix_job_resources($settings); }, ); option slots_per_job => ( type => 's', short => 'x', description => "This sets the number of slots each job will use (default 1). This is normally set by the ':#' in '-j#:#'.", env_vars => ['T2_HARNESS_JOB_CONCURRENCY'], clear_env_vars => 1, long_examples => [' 2'], short_examples => ['2'], ); option dump_depmap => ( type => 'b', description => "When using staged preload, dump the depmap for each stage as json files", default => 0, ); option includes => ( name => 'include', short => 'I', type => 'm', description => "Add a directory to your include paths", ); option resources => ( name => 'resource', short => 'R', type => 'm', description => "Use a resource module to assign resource assignments to individual tests", long_examples => [' Port', ' +Test2::Harness::Runner::Resource::Port'], short_examples => [' Port'], normalize => sub { my $val = shift; $val = "Test2::Harness::Runner::Resource::$val" unless $val =~ s/^\+//; return $val; }, ); option tlib => ( description => "(Default: off) Include 't/lib' in your module path", default => 0, action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; push @{$settings->runner->includes} => File::Spec->catdir('t', 'lib'); }, ); option lib => ( short => 'l', description => "(Default: include if it exists) Include 'lib' in your module path", default => 1, action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; push @{$settings->runner->includes} => 'lib'; $settings->runner->lib(0); $settings->runner->blib(0); }, ); option blib => ( short => 'b', description => "(Default: include if it exists) Include 'blib/lib' and 'blib/arch' in your module path", default => 1, action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; push @{$settings->runner->includes} => ( File::Spec->catdir('blib', 'lib'), File::Spec->catdir('blib', 'arch'), ); $settings->runner->lib(0); $settings->runner->blib(0); }, ); option unsafe_inc => ( description => "perl is removing '.' from \@INC as a security concern. This option keeps things from breaking for now.", env_vars => [qw/PERL_USE_UNSAFE_INC/], default => 0, ); option preloads => ( type => 'm', alt => ['preload'], short => 'P', description => 'Preload a module before running tests', ); option preload_threshold => ( short => 'W', alt => ['Pt'], type => 's', default => 0, description => "Only do preload if at least N tests are going to be run. In some cases a full preload takes longer than simply running the tests, this lets you specify a minimum number of test jobs that will be run for preload to happen. This has no effect for a persistent runner. The default is 0, and it means always preload." ); option nytprof => ( type => 'b', description => "Use Devel::NYTProf on tests. This will set addpid=1 for you. This works with or without fork.", long_examples => [''], ); post \&cover_post_process; option cover => ( type => 'd', description => "Use Devel::Cover to calculate test coverage. This disables forking. If no args are specified the following are used: $DEFAULT_COVER_ARGS", long_examples => ['', '=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl'], action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; return $$slot = $DEFAULT_COVER_ARGS if $norm eq '1'; return $$slot = $norm; }, ); option switch => ( field => 'switches', short => 'S', type => 'm', description => 'Pass the specified switch to perl for each test. This is not compatible with preload.', ); option event_timeout => ( alt => ['et'], type => 's', default => 60, long_examples => [' SECONDS'], short_examples => [' SECONDS'], description => 'Kill test if no output is received within timeout period. (Default: 60 seconds). Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. This prevents a hung test from running forever.', ); option post_exit_timeout => ( alt => ['pet'], type => 's', default => 15, long_examples => [' SECONDS'], short_examples => [' SECONDS'], description => 'Stop waiting post-exit after the timeout period. (Default: 15 seconds) Some tests fork and allow the parent to exit before writing all their output. If Test2::Harness detects an incomplete plan after the test exits it will monitor for more events until the timeout period. Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis.' ); option runner_id => ( type => 's', default => sub { gen_uuid() }, description => 'Runner ID (usually a generated uuid)', ); }; sub jobs_post_process { my %params = @_; my $settings = $params{settings}; my $runner = $settings->runner or return; fix_job_resources($settings); $ENV{T2_HARNESS_MY_JOB_COUNT} = $runner->job_count; $ENV{T2_HARNESS_MY_MAX_JOB_CONCURRENCY} = $runner->slots_per_job; } sub fix_job_resources { my ($settings) = @_; my $runner = $settings->runner; require Test2::Harness::Runner::Resource::SharedJobSlots::Config; my $sconf = Test2::Harness::Runner::Resource::SharedJobSlots::Config->find(settings => $settings); my %found; for my $r (@{$runner->resources}) { require(mod2file($r)); next unless $r->job_limiter; $found{$r}++; } if ($sconf && !$found{'Test2::Harness::Runner::Resource::SharedJobSlots'} && !$sconf->disabled) { if (delete $found{'Test2::Harness::Runner::Resource::JobCount'}) { @{$settings->runner->resources} = grep { $_ ne 'Test2::Harness::Runner::Resource::JobCount' } @{$runner->resources}; } if (!keys %found) { require Test2::Harness::Runner::Resource::SharedJobSlots; unshift @{$runner->resources} => 'Test2::Harness::Runner::Resource::SharedJobSlots'; $found{'Test2::Harness::Runner::Resource::SharedJobSlots'}++; } } elsif (!keys %found) { require Test2::Harness::Runner::Resource::JobCount; unshift @{$runner->resources} => 'Test2::Harness::Runner::Resource::JobCount'; } if ($found{'Test2::Harness::Runner::Resource::SharedJobSlots'} && $sconf) { $runner->field(job_count => $sconf->default_slots_per_run || $sconf->max_slots_per_run) if $runner && !$runner->job_count; $runner->field(slots_per_job => $sconf->default_slots_per_job || $sconf->max_slots_per_job) if $runner && !$runner->slots_per_job; my $run_slots = $runner->job_count; my $job_slots = $runner->slots_per_job; die "Requested job count ($run_slots) exceeds the system shared limit (" . $sconf->max_slots_per_run . ").\n" if $run_slots > $sconf->max_slots_per_run; die "Requested job concurrency ($job_slots) exceeds the system shared limit (" . $sconf->max_slots_per_job . ").\n" if $job_slots > $sconf->max_slots_per_job; } $runner->field(job_count => 1) if $runner && !$runner->job_count; $runner->field(slots_per_job => 1) if $runner && !$runner->slots_per_job; my $run_slots = $runner->job_count; my $job_slots = $runner->slots_per_job; die "The slots_per_job (set to $job_slots) must not be larger than the job_count (set to $run_slots).\n" if $job_slots > $run_slots; } sub cover_post_process { my %params = @_; my $settings = $params{settings}; if ($ENV{T2_DEVEL_COVER} && !$settings->runner->cover) { $settings->runner->field(cover => $ENV{T2_DEVEL_COVER} eq '1' ? $ENV{T2_DEVEL_COVER} : $DEFAULT_COVER_ARGS); } return unless $settings->runner->cover; # For nested things $ENV{T2_NO_FORK} = 1; $ENV{T2_DEVEL_COVER} = $settings->runner->cover; $settings->runner->field(use_fork => 0); return unless $settings->check_prefix('run'); push @{$settings->run->load_import->{'@'}} => 'Devel::Cover'; $settings->run->load_import->{'Devel::Cover'} = [split(/,/, $settings->runner->cover)]; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Runner - Runner options for Yath. =head1 DESCRIPTION This is where command line options for the runner are defined. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Runner Options =over 4 =item --abort-on-bail =item --no-abort-on-bail Abort all testing if a bail-out is encountered (default: on) =item --blib =item -b =item --no-blib (Default: include if it exists) Include 'blib/lib' and 'blib/arch' in your module path =item --cover =item --cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --no-cover Use Devel::Cover to calculate test coverage. This disables forking. If no args are specified the following are used: -silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --dump-depmap =item --no-dump-depmap When using staged preload, dump the depmap for each stage as json files =item --event-timeout SECONDS =item --et SECONDS =item --no-event-timeout Kill test if no output is received within timeout period. (Default: 60 seconds). Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. This prevents a hung test from running forever. =item --include ARG =item --include=ARG =item -I ARG =item -I=ARG =item --no-include Add a directory to your include paths Can be specified multiple times =item --job-count 4 =item --job-count 8:2 =item --jobs 4 =item --jobs 8:2 =item -j4 =item -j8:2 =item --no-job-count Set the number of concurrent jobs to run. Add a :# if you also wish to designate multiple slots per test. 8:2 means 8 slots, but each test gets 2 slots, so 4 tests run concurrently. Tests can find their concurrency assignemnt in the "T2_HARNESS_MY_JOB_CONCURRENCY" environment variable. Can also be set with the following environment variables: C, C, C =item --lib =item -l =item --no-lib (Default: include if it exists) Include 'lib' in your module path =item --nytprof =item --no-nytprof Use Devel::NYTProf on tests. This will set addpid=1 for you. This works with or without fork. =item --post-exit-timeout SECONDS =item --pet SECONDS =item --no-post-exit-timeout Stop waiting post-exit after the timeout period. (Default: 15 seconds) Some tests fork and allow the parent to exit before writing all their output. If Test2::Harness detects an incomplete plan after the test exits it will monitor for more events until the timeout period. Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. =item --preload-threshold ARG =item --preload-threshold=ARG =item --Pt ARG =item --Pt=ARG =item -W ARG =item -W=ARG =item --no-preload-threshold Only do preload if at least N tests are going to be run. In some cases a full preload takes longer than simply running the tests, this lets you specify a minimum number of test jobs that will be run for preload to happen. This has no effect for a persistent runner. The default is 0, and it means always preload. =item --preloads ARG =item --preloads=ARG =item --preload ARG =item --preload=ARG =item -P ARG =item -P=ARG =item --no-preloads Preload a module before running tests Can be specified multiple times =item --resource Port =item --resource +Test2::Harness::Runner::Resource::Port =item -R Port =item --no-resource Use a resource module to assign resource assignments to individual tests Can be specified multiple times =item --runner-id ARG =item --runner-id=ARG =item --no-runner-id Runner ID (usually a generated uuid) =item --shared-jobs-config .sharedjobslots.yml =item --shared-jobs-config relative/path/.sharedjobslots.yml =item --shared-jobs-config /absolute/path/.sharedjobslots.yml =item --no-shared-jobs-config Where to look for a shared slot config file. If a filename with no path is provided yath will search the current and all parent directories for the name. =item --slots-per-job 2 =item -x2 =item --no-slots-per-job This sets the number of slots each job will use (default 1). This is normally set by the ':#' in '-j#:#'. Can also be set with the following environment variables: C =item --switch ARG =item --switch=ARG =item -S ARG =item -S=ARG =item --no-switch Pass the specified switch to perl for each test. This is not compatible with preload. Can be specified multiple times =item --tlib =item --no-tlib (Default: off) Include 't/lib' in your module path =item --unsafe-inc =item --no-unsafe-inc perl is removing '.' from @INC as a security concern. This option keeps things from breaking for now. Can also be set with the following environment variables: C =item --use-fork =item --fork =item --no-use-fork (default: on, except on windows) Normally tests are run by forking, which allows for features like preloading. This will turn off the behavior globally (which is not compatible with preloading). This is slower, it is better to tag misbehaving tests with the '# HARNESS-NO-PRELOAD' comment in their header to disable forking only for those tests. Can also be set with the following environment variables: C, C, C, C, C =item --use-timeout =item --timeout =item --no-use-timeout (default: on) Enable/disable timeouts =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Options/Finder.pm0000644000175000017500000005275115012417054021676 0ustar exodistexodistpackage App::Yath::Options::Finder; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Harness::Util qw/mod2file/; use App::Yath::Options; my %RERUN_MODES = ( all => "Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that.", failed => "Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that.", retried => "Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that.", passed => "Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that.", missed => "Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that.", ); option_group {prefix => 'finder', category => "Finder Options", builds => 'Test2::Harness::Finder'} => sub { option finder => ( type => 's', default => 'Test2::Harness::Finder', description => 'Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed.', long_examples => [' MyFinder', ' +Test2::Harness::Finder::MyFinder'], pre_command => 1, adds_options => 1, pre_process => \&finder_pre_process, action => \&finder_action, builds => undef, # This option is not for the build ); option extension => ( field => 'extensions', type => 'm', alt => ['ext'], description => 'Specify valid test filename extensions, default: t and t2', ); option search => ( type => 'm', description => 'List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix.', ); option no_long => ( description => "Do not run tests that have their duration flag set to 'LONG'", ); option only_long => ( description => "Only run tests that have their duration flag set to 'LONG'", ); option show_changed_files => ( description => "Print a list of changed files if any are found", applicable => \&changes_applicable, ); option changed_only => ( description => "Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff())", applicable => \&changes_applicable, ); option rerun => ( type => 'd', description => "Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that.", long_examples => ['', '=path/to/log.jsonl', '=plugin_specific_string'], ); option rerun_plugin => ( type => 'm', description => "What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used ot set an order of priority)", long_examples => [' Foo', ' +App::Yath::Plugin::Foo'], ); option rerun_modes => ( alt => ['rerun-mode'], type => 'm', description => "Pick which test categories to run", long_examples => [' failed,missed,...', map {" $_"} sort keys %RERUN_MODES], ); for my $mode (keys %RERUN_MODES) { option "rerun_$mode" => ( type => 'd', description => $RERUN_MODES{$mode}, long_examples => ['', '=path/to/log.jsonl', '=plugin_specific_string'], ignore_for_build => 1, ); } option changed => ( type => 'm', description => "Specify one or more files as having been changed.", long_examples => [' path/to/file'], applicable => \&changes_applicable, ); option changes_exclude_file => ( type => 'm', description => 'Specify one or more files to ignore when looking at changes', long_examples => [' path/to/file'], applicable => \&changes_applicable, ); option changes_exclude_pattern => ( type => 'm', description => 'Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check.', long_examples => [" '(apple|pear|orange)'"], applicable => \&changes_applicable, ); option changes_filter_file => ( type => 'm', description => 'Specify one or more files to check for changes. Changes to other files will be ignored', long_examples => [' path/to/file'], applicable => \&changes_applicable, ); option changes_filter_pattern => ( type => 'm', description => 'Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check.', long_examples => [" '(apple|pear|orange)'"], applicable => \&changes_applicable, ); option changes_diff => ( type => 's', description => "Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000`", long_examples => [' path/to/diff.diff'], applicable => \&changes_applicable, ); option changes_plugin => ( type => 's', description => "What plugin should be used to detect changed files.", long_examples => [' Git', ' +App::Yath::Plugin::Git'], applicable => \&changes_applicable, ); option changes_include_whitespace => ( type => 'b', description => "Include changed lines that are whitespace only (default: off)", applicable => \&changes_applicable, default => 0, ); option changes_exclude_nonsub => ( type => 'b', description => "Exclude changes outside of subroutines (perl files only) (default: off)", applicable => \&changes_applicable, default => 0, ); option changes_exclude_loads => ( type => 'b', description => "Exclude coverage tests which only load changed files, but never call code from them. (default: off)", applicable => \&changes_applicable, default => 0, ); option changes_exclude_opens => ( type => 'b', description => "Exclude coverage tests which only open() changed files, but never call code from them. (default: off)", applicable => \&changes_applicable, default => 0, ); option durations => ( type => 's', long_examples => [' file.json', ' http://example.com/durations.json'], short_examples => [' file.json', ' http://example.com/durations.json'], description => "Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work.", ); option maybe_durations => ( type => 's', long_examples => [' file.json', ' http://example.com/durations.json'], short_examples => [' file.json', ' http://example.com/durations.json'], description => "Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work.", ); option durations_threshold => ( alt => ['Dt'], type => 's', default => undef, description => "Only fetch duration data if running at least this number of tests. Default (-j value + 1)" ); option exclude_file => ( field => 'exclude_files', type => 'm', long_examples => [' t/nope.t'], short_examples => [' t/nope.t'], description => "Exclude a file from testing", ); option exclude_pattern => ( field => 'exclude_patterns', type => 'm', long_examples => [' t/nope.t'], short_examples => [' t/nope.t'], description => "Exclude a pattern from testing, matched using m/\$PATTERN/", ); option exclude_list => ( field => 'exclude_lists', type => 'm', long_examples => [' file.txt', ' http://example.com/exclusions.txt'], short_examples => [' file.txt', ' http://example.com/exclusions.txt'], description => "Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files).", ); option default_search => ( type => 'm', description => "Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line", ); option default_at_search => ( type => 'm', description => "Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line", ); post \&_post_process; }; sub _post_process { my %params = @_; my $settings = $params{settings}; my $options = $params{options}; my $finder = $settings->finder; my $rerun = $finder->rerun; for my $mode (sort keys %RERUN_MODES) { my $val = $finder->remove_field("rerun_$mode") or next; push @{$finder->rerun_modes} => $mode; next if $val eq '1'; $rerun //= $val; $rerun = $val if $rerun eq '1'; die "Multiple runs specified for rerun ($val and $rerun). Please pick one.\n" if $val ne $rerun; } $finder->field(rerun => $rerun); my (%seen, @keep); for my $mode (sort map { split /,/ } @{$finder->rerun_modes}) { next if $seen{$mode}++; die "Invalid rerun-mode '$mode'.\n" unless $RERUN_MODES{$mode}; push @keep => $mode; } push @keep => 'all' unless @keep; @{$finder->rerun_modes} = @keep; if (!defined($settings->finder->durations_threshold)) { if ($settings->check_prefix('runner')) { my $jc = $settings->runner->job_count // 1; $settings->finder->field(durations_threshold => $jc + 1); } $settings->finder->field(durations_threshold => 1); } $settings->finder->field(default_search => ['./t', './t2', 'test.pl']) unless $settings->finder->default_search && @{$settings->finder->default_search}; $settings->finder->field(default_at_search => ['./xt']) unless $settings->finder->default_at_search && @{$settings->finder->default_at_search}; @{$settings->finder->extensions} = ('t', 't2') unless @{$settings->finder->extensions}; s/^\.//g for @{$settings->finder->extensions}; } sub normalize_class { my ($class) = @_; $class = "Test2::Harness::Finder::$class" unless $class =~ s/^\+//; my $file = mod2file($class); require $file; return $class; } sub finder_pre_process { my %params = @_; my $class = $params{val} or return; $class = normalize_class($class); return unless $class->can('options'); $params{options}->include_from($class); } sub finder_action { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler, $options) = @_; my $class = $norm; $class = normalize_class($class); if ($class->can('options')) { $options->populate_pre_defaults(); $options->populate_cmd_defaults(); } $class->munge_settings($settings, $options) if $class->can('munge_settings'); $handler->($slot, $class); } sub changes_applicable { my ($option, $options) = @_; # Cannot use this options with projects return 0 if $options->command_class && $options->command_class->isa('App::Yath::Command::projects'); return 1; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Finder - Finder options for Yath. =head1 DESCRIPTION This is where the command line options for discovering test files are defined. =head1 PROVIDED OPTIONS =head2 YATH OPTIONS (PRE-COMMAND) =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head2 COMMAND OPTIONS =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used ot set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Options/Debug.pm0000644000175000017500000002217115012417054021506 0ustar exodistexodistpackage App::Yath::Options::Debug; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Harness::Util::JSON qw/encode_pretty_json/; use Test2::Util::Table qw/table/; use Test2::Harness::Util qw/find_libraries mod2file clean_path/; use Errno qw/EINTR/; use App::Yath::Options; option_group {prefix => 'debug', category => 'Help and Debugging'} => sub { post 99999 => \&_post_process_show_opts; post 99998 => \&_post_process_interactive; post \&_post_process_version; post \&_post_process_help; option dummy => ( short => 'd', description => 'Dummy run, do not actually execute anything', env_vars => [qw/T2_HARNESS_DUMMY/], clear_env_vars => 1, default => 0, ); option procname_prefix => ( type => 's', default => '', description => 'Add a prefix to all proc names (as seen by ps).', ); option keep_dirs => ( short => 'k', alt => ['keep_dir'], description => 'Do not delete directories when done. This is useful if you want to inspect the directories used for various commands.', default => 0, ); option 'show-opts' => ( description => 'Exit after showing what yath thinks your options mean', pre_command => 1, ); option version => ( short => 'V', description => "Exit after showing a helpful usage message", pre_command => 1, ); option help => ( short => 'h', description => "exit after showing help information", ); option interactive => ( short => 'i', description => 'Use interactive mode, 1 test at a time, stdin forwarded to it', ); option summary => ( type => 'd', description => "Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted.", long_examples => ['', '=/path/to/summary.json'], normalize => \&normalize_summary, action => \&summary_action, applicable => sub { my ($option, $options) = @_; return 1 if $options->included->{'App::Yath::Options::Run'}; return 0; }, ); }; sub normalize_summary { my $val = shift; return $val if $val eq '1'; $val =~ s/\.json$//g; $val .= '.json'; return clean_path($val); } sub summary_action { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; return $$slot = clean_path($norm) unless $norm eq '1'; return if $$slot; return $$slot = clean_path('summary.json'); } sub _post_process_help { my %params = @_; return unless $params{settings}->debug->help; my $help; if (my $cmd = $params{command}) { $help = $cmd->cli_help(%params); } else { $help = __PACKAGE__->cli_help(%params); } if (eval { require IO::Pager; 1 }) { local $SIG{PIPE} = sub {}; my $pager = IO::Pager->new(*STDOUT); $pager->print($help); } else { print $help; } exit 0; } sub _post_process_show_opts { my %params = @_; return unless $params{settings}->debug->show_opts; my $settings = $params{settings}; print "\nCommand selected: " . $params{command}->name . " (" . ref($params{command}) . ")\n" if $params{command}; my $args = $params{args}; print "\nCommand args: " . join(', ' => @$args) . "\n" if @$args; my $out = encode_pretty_json($settings); print "\nCurrent command line and config options result in these settings:\n"; print "$out\n"; exit 0; } my $RAN = 0; sub _post_process_interactive { return if $RAN++; my %params = @_; return unless $params{settings}->debug->interactive; my $settings = $params{settings}; my ($fifo); if ($settings->check_prefix('workspace')) { my $dir = $settings->workspace->workdir; $fifo = "$dir/fifo-$$"; } else { require File::Temp; my $fh; ($fh, $fifo) = File::Temp::tempfile("YATH-FIFO-$$-XXXXXX", TMPDIR => 1); close($fh); unlink($fifo); } ${$settings->debug->vivify_field('fifo')} = $fifo; if ($settings->check_prefix('display')) { $settings->display->field(quiet => 0); $settings->display->field(verbose => 1) unless $settings->display->verbose; } if ($settings->check_prefix('formatter')) { $settings->formatter->field(qvf => 0); } if ($settings->check_prefix('run')) { $settings->run->env_vars->{YATH_INTERACTIVE} = $fifo; $ENV{YATH_INTERACTIVE} = $fifo; } my $pid = fork() // die "Could not fork: $!"; if ($pid) { require Scope::Guard; require POSIX; POSIX::mkfifo($fifo, 0700) or die "Failed to make fifo ($fifo): $!"; my $fh; my $cleanup = sub { close($fh) if $fh; unlink($fifo) if -e $fifo; }; my $old_int_handler = $SIG{INT}; my $old_term_handler = $SIG{TERM}; $SIG{INT} = sub { $cleanup->('INT'); $old_int_handler->() if ref $old_int_handler; exit 1; }; $SIG{TERM} = sub { $cleanup->('TERM'); $old_term_handler->() if ref $old_term_handler; exit 1; }; $SIG{PIPE} = sub { exit 1 }; $SIG{CHLD} = sub { my $res = waitpid($pid, 0); my $exit = ($? >> 8); close($fh) if $fh; unlink($fifo) if -e $fifo; # Forward the exit code from our child exit($exit); }; for (1 .. 10) { last if open($fh, '>', $fifo); die "Could not open fifo ($fifo): $!" unless $! == EINTR; sleep 1; } die "Could not open fifo ($fifo): $!" unless $fh; $fh->autoflush(1); my $guard = Scope::Guard->new($cleanup); while(1) { my $data = ; if (defined($data) && length($data)) { print $fh $data; next; } next if defined($data); next if kill(0, $pid); print STDERR "Lost child process $pid\n"; $cleanup->(); exit 255; } } close(STDIN); open(STDIN, '<', '/dev/null'); require Time::HiRes; while (! -e $fifo) { Time::HiRes::sleep(0.1) }; } sub _post_process_version { my %params = @_; return unless $params{settings}->debug->version; require App::Yath; my $out = <<" EOT"; Yath version: $App::Yath::VERSION Extended Version Info EOT my $plugin_libs = find_libraries('App::Yath::Plugin::*'); my @vers = ( [perl => $^V], ['App::Yath' => App::Yath->VERSION], ( map { eval { require(mod2file($_)); 1 } ? [$_ => $_->VERSION // 'N/A'] : [$_ => 'N/A'] } qw/Test2::API Test2::Suite Test::Builder/ ), ( map { eval { require($plugin_libs->{$_}); 1 } && [$_ => $_->VERSION // 'N/A'] } sort keys %$plugin_libs ), ); $out .= join "\n" => table( header => [qw/COMPONENT VERSION/], rows => \@vers, ); print "$out\n\n"; exit 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Debug - Debug options for Yath =head1 DESCRIPTION This is where debug related command line options live. =head1 PROVIDED OPTIONS =head2 YATH OPTIONS (PRE-COMMAND) =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head2 COMMAND OPTIONS =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Options/Run.pm0000644000175000017500000002332115012417054021222 0ustar exodistexodistpackage App::Yath::Options::Run; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Harness::Util::UUID qw/gen_uuid/; use App::Yath::Options; option_group {prefix => 'run', category => "Run Options", builds => 'Test2::Harness::Run'} => sub { post \&post_process; option link => ( field => 'links', type => 'm', long_examples => [ " 'https://travis.work/builds/42'", " 'https://jenkins.work/job/42'", " 'https://buildbot.work/builders/foo/builds/42'", ], description => "Provide one or more links people can follow to see more about this run." ); option test_args => ( type => 'm', description => 'Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the \'::\' argument separator.' ); option input => ( type => 's', description => 'Input string to be used as standard input for ALL tests. See also: --input-file', ); option input_file => ( type => 's', description => 'Use the specified file as standard input to ALL tests', action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; die "Input file not found: $norm\n" unless -f $norm; if ($settings->run->input) { warn "Input file is overriding another source of input.\n"; $settings->run->field(input => undef); } $handler->($slot, $norm); }, ); option dbi_profiling => ( type => 'b', description => "Use Test2::Plugin::DBIProfile to collect database profiling data", ); option author_testing => ( short => 'A', description => 'This will set the AUTHOR_TESTING environment to true', ); option use_stream => ( name => 'stream', description => "Use the stream formatter (default is on)", default => 1, ); option tap => ( field => 'use_stream', alt => ['TAP', '--no-stream'], normalize => sub { $_[0] ? 0 : 1 }, description => "The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help." ); option fields => ( type => 'm', short => 'f', long_examples => [' name:details', ' JSON_STRING'], short_examples => [' name:details', ' JSON_STRING'], description => "Add custom data to the harness run", action => \&fields_action, ); option env_var => ( field => 'env_vars', short => 'E', type => 'h', long_examples => [' VAR=VAL'], short_examples => ['VAR=VAL', ' VAR=VAL'], description => 'Set environment variables to set when each test is run.', ); option run_id => ( alt => ['id'], description => 'Set a specific run-id. (Default: a UUID)', default => \&gen_uuid, ); option load => ( type => 'm', short => 'm', alt => ['load-module'], description => 'Load a module in each test (after fork). The "import" method is not called.', ); option load_import => ( type => 'H', short => 'M', alt => ['loadim'], long_examples => [' Module', ' Module=import_arg1,arg2,...'], short_examples => [' Module', ' Module=import_arg1,arg2,...'], description => 'Load a module in each test (after fork). Import is called.', ); option event_uuids => ( default => 1, alt => ['uuids'], description => 'Use Test2::Plugin::UUID inside tests (default: on)', ); option mem_usage => ( default => 1, description => 'Use Test2::Plugin::MemUsage inside tests (default: on)', ); option io_events => ( default => 0, description => 'Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off)', ); option retry => ( default => 0, short => 'r', type => 's', description => 'Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice!', ); option retry_isolated => ( default => 0, alt => ['retry-iso'], type => 'b', description => 'If true then any job retries will be done in isolation (as though -j1 was set)', ); }; sub post_process { my %params = @_; my $settings = $params{settings}; $settings->run->env_vars->{AUTHOR_TESTING} = 1 if $settings->run->author_testing; if ($settings->run->dbi_profiling) { eval { require Test2::Plugin::DBIProfile; 1 } or die "Could not enable DBI profiling, could not load 'Test2::Plugin::DBIProfile': $@"; push @{$settings->run->load_import->{'@'}} => 'Test2::Plugin::DBIProfile'; $settings->run->load_import->{'Test2::Plugin::DBIProfile'} = []; } } sub fields_action { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; my $fields = ${$slot} //= []; if ($norm =~ m/^{/) { my $field = {}; my $ok = eval { $field = Test2::Harness::Util::JSON::decode_json($norm); 1 }; chomp(my $error = $@ // ''); die "Error parsing field specification '$field': $error\n" unless $ok; die "Fields must have a 'name' key (error in '$raw')\n" unless $field->{name}; die "Fields must habe a 'details' key (error in '$raw')\n" unless $field->{details}; return push @$fields => $field; } elsif ($norm =~ m/([^:]+):([^:]+)/) { return push @$fields => {name => $1, details => $2}; } die "'$raw' is not a valid field specification.\n"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Run - Run options for Yath. =head1 DESCRIPTION This is where command lines options for a single test run are defined. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Plugin/0000755000175000017500000000000015012417054017722 5ustar exodistexodistTest2-Harness-1.000158/lib/App/Yath/Plugin/SysInfo.pm0000644000175000017500000000460615012417054021660 0ustar exodistexodistpackage App::Yath::Plugin::SysInfo; use strict; use warnings; our $VERSION = '1.000158'; use Sys::Hostname qw/hostname/; use Test2::Util qw/CAN_THREAD CAN_REALLY_FORK CAN_FORK CAN_SIGSYS/; use Config qw/%Config/; use parent 'App::Yath::Plugin'; use Test2::Harness::Util::HashBase qw/-host_short_pattern/; sub inject_run_data { my $self = shift; my %params = @_; my $meta = $params{meta}; my $fields = $params{fields}; my %data = ( env => { user => $ENV{USER}, shell => $ENV{SHELL}, term => $ENV{TERM}, }, ipc => { can_fork => CAN_FORK(), can_really_fork => CAN_REALLY_FORK(), can_thread => CAN_THREAD(), can_sigsys => CAN_SIGSYS(), }, ); my ($short, $raw) = ('sys', 'system info'); if (my $hostname = hostname()) { $short = undef; $data{hostname} = $hostname; $raw = $hostname; if (my $pattern = $self->{+HOST_SHORT_PATTERN}) { if ($hostname =~ /($pattern)/) { $short = $1; } } unless ($short) { $short = $hostname; $short =~ s/\.[^\.]*$// while length($short) > 18 && $short =~ m/\./; } } my @fields = qw/uselongdouble use64bitall version use64bitint usemultiplicity osname useperlio useithreads archname/; @{$data{config}}{@fields} = @Config{@fields}; push @$fields => { name => 'sys', details => $short, raw => $raw, data => \%data, }; } sub TO_JSON { ref($_[0]) } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Plugin::SysInfo - Plugin to attach system information to a run. =head1 DESCRIPTION This plugin attaches a lot of system information to the yath log. This is mainly useful if you intend to view the log in L. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Plugin/Notify.pm0000644000175000017500000004672115012417054021542 0ustar exodistexodistpackage App::Yath::Plugin::Notify; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Harness::Util::JSON qw/encode_json/; use Test2::Harness::Util qw/mod2file/; use Sys::Hostname qw/hostname/; use Carp qw/croak confess/; use App::Yath::Options; use parent 'App::Yath::Plugin'; use Test2::Harness::Util::HashBase qw/-final -tries -problems -problem_cids +text_mod +text_mod_handles_events +text_mod_fail/; # Notifications only apply to commands which build a run. sub applicable { my ($option, $options) = @_; return 1 if $options->included->{'App::Yath::Options::Run'}; return 0; } option_group {prefix => 'notify', category => "Notification Options", applicable => \&applicable} => sub { option slack => ( type => 'm', description => "Send results to a slack channel and/or user", long_examples => [" '#foo'", " '\@bar'"], ); option slack_fail => ( type => 'm', description => "Send failing results to a slack channel and/or user", long_examples => [" '#foo'", " '\@bar'"], ); option slack_url => ( type => 's', description => "Specify an API endpoint for slack webhook integrations", long_examples => [" https://hooks.slack.com/..."], ); option slack_owner => ( type => 'b', description => "Send slack notifications to the slack channels/users listed in test meta-data when tests fail.", default => 0, ); option no_batch_slack => ( type => 'b', default => 0, description => 'Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen.', ); option email_from => ( type => 's', long_examples => [' foo@example.com'], description => "If any email is sent, this is who it will be from", default => sub { my $user = getlogin() || scalar(getpwuid($<)) || $ENV{USER} || 'unknown'; my $host = hostname() || 'unknown'; return "${user}\@${host}"; }, ); option email => ( type => 'm', long_examples => [' foo@example.com'], description => "Email the test results to the specified email address(es)", ); option email_fail => ( type => 'm', long_examples => [' foo@example.com'], description => "Email failing results to the specified email address(es)", ); option email_owner => ( type => 'b', description => 'Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner', default => 0, ); option no_batch_email => ( type => 'b', default => 0, description => 'Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen.', ); option text => ( type => 's', alt => ['message', 'msg'], description => "Add a custom text snippet to email/slack notifications", ); option text_module => ( type => 's', alt => ['message_module'], description => "Use the specified module to generate messages for emails and/or slack.", ); post sub { my %params = @_; my $settings = $params{settings}; my $options = $params{options}; my $set_by_cli = $options->set_by_cli->{notify}; # Should we use email? if (@{$settings->notify->email} || $settings->notify->email_owner) { $settings->notify->field(email_owner => 1) unless $set_by_cli->{email_owner}; # Do we have Email::Stuffer? eval { require Email::Stuffer; 1 } or die "Cannot use --email-owner without Email::Stuffer, which is not installed.\n"; push @{$settings->harness->plugins} => __PACKAGE__->new() unless grep { $_->isa(__PACKAGE__) } @{$settings->harness->plugins}; } my $use_slack = grep { $settings->notify->$_ } qw/slack_url slack_owner/; $use_slack ||= grep { @{$settings->notify->$_} } qw/slack slack_fail/; if ($use_slack) { die "slack url must be provided in order to use slack" unless $settings->notify->slack_url; eval { require HTTP::Tiny; 1 } or die "Cannot use slack without HTTP::Tiny which is not installed.\n"; die "HTTP::Tiny reports that it does not support SSL, cannot use slack without ssl." unless HTTP::Tiny::can_ssl(); $settings->notify->field(slack_owner => 1) unless $set_by_cli->{slack_owner}; push @{$settings->harness->plugins} => __PACKAGE__->new() unless grep { $_->isa(__PACKAGE__) } @{$settings->harness->plugins}; } }; }; sub text_mod { my $self = shift; my ($settings) = @_; croak 'settings is a required argument' unless $settings; return $self->{+TEXT_MOD} if exists $self->{+TEXT_MOD}; if (my $tm = $settings->notify->text_module) { my $file = mod2file($tm); if (eval { require $file; 1 }) { my $inst = $tm->can('new') ? $tm->new() : $tm; $self->{+TEXT_MOD_HANDLES_EVENTS} = $inst->can('handle_event') ? 1 : 0; return $self->{+TEXT_MOD} = $inst; } else { my $err = $@; warn "Cannot use module '$tm' for notification text generation: $err"; chomp($self->{+TEXT_MOD_FAIL} = $err); } } $self->{+TEXT_MOD_HANDLES_EVENTS} = 0; return $self->{+TEXT_MOD} = undef; } sub handle_event { my $self = shift; my ($e, $settings) = @_; my $f = $e->facet_data; $self->record_problem($f); my $tm = $self->text_mod($settings); if ($tm && $self->{+TEXT_MOD_HANDLES_EVENTS}) { $tm->handle_event($e, $f, settings => $settings, notify => $self); } return $self->handle_job_end($e, $f, $settings) if $f->{harness_job_end}; return $self->handle_final($e, $f, $settings) if $f->{harness_final}; return; } sub record_problem { my $self = shift; my ($f) = @_; return unless $self->has_fail_or_error($f); my $job_id = $f->{harness}->{job_id}; my $job_try = $f->{harness}->{job_try} // 0; push @{$self->{+PROBLEMS}->{$job_id}->{$job_try}} => $self->prune_subtests($f); } sub has_fail_or_error { my $self = shift; my ($f, %params) = @_; return 0 if $f->{trace}->{nested} && !$params{allow_nested}; return 0 if $f->{amnesty} && @{$f->{amnesty}}; my $out = 0; my $cid = $f->{trace}->{cid}; $out = 1 if $cid && $self->{+PROBLEM_CIDS}->{$cid} && $f->{info} && @{$f->{info}}; $out = 1 if $f->{errors} && @{$f->{errors}}; $out = 1 if $f->{assert} && !$f->{assert}->{pass}; $self->{+PROBLEM_CIDS}->{$cid} = 1 if $cid && $out; return $out; } sub prune_subtests { my $self = shift; my ($f) = @_; my $p = $f->{parent} // return $f; my $c = $p->{children} // return $f; return $f unless @$c; my $out = {}; $out->{$_} = $f->{$_} for grep { $f->{$_} } qw/assert about trace errors info harness control/; $out->{parent} = {%$p, children => [map { $self->prune_subtests($_) } grep { $self->has_fail_or_error($_, allow_nested => 1) } @$c]}; return $out; } sub handle_final { my $self = shift; my ($e, $f, $settings) = @_; $self->{+FINAL} = $e; } sub handle_job_end { my $self = shift; my ($e, $f, $settings) = @_; return unless $f->{harness_job_end}->{fail}; my $job_id = $f->{harness}->{job_id}; if ($f->{harness_job_end}->{retry}) { $self->{+TRIES}->{$job_id}++; return; } my @args = ($e, $f, $self->{+TRIES}->{$job_id}, $settings); $self->send_job_notification_slack(@args); $self->send_job_notification_email(@args); } sub send_job_notification_slack { my $self = shift; my ($e, $f, $tries, $settings) = @_; return unless $settings->notify->no_batch_slack; my $tf = Test2::Harness::TestFile->new(file => $f->{harness_job_end}->{abs_file}); my @slack; push @slack => $tf->meta('slack') if $settings->notify->slack_owner; push @slack => @{$settings->notify->slack_fail}; return unless @slack; my $text = $self->gen_text(scope => 'job', service => 'slack', settings => $settings, file => $tf, tries => $tries); $self->_send_slack($text, $settings, @slack); } sub gen_slack_job_text { my $self = shift; my %params = @_; my $settings = $params{settings} // croak "'settings' is required"; my $tf = $params{file} // croak "'file' is required"; my $tries = $params{tries} // 0; my $host = hostname(); my $file = $tf->relative; return join "\n\n" => grep { $_ } $settings->notify->text, "Failed test on $host: '$file'.", $tries ? ("Test was run " . (1 + $tries) . " time(s).") : (), join "\n" => map {"> <$_|$_>"} @{$settings->run->links}; } sub _send_slack { my $self = shift; my ($text, $settings, @to) = @_; require HTTP::Tiny; my $ht = HTTP::Tiny->new(); for my $dest (@to) { my $r = $ht->post( $settings->notify->slack_url, { headers => {'content-type' => 'application/json'}, content => encode_json({channel => $dest, text => $text}), }, ); warn "Failed to send slack message to '$dest'" unless $r->{success}; } } sub send_job_notification_email { my $self = shift; my ($e, $f, $tries, $settings) = @_; return unless $settings->notify->no_batch_email; my $tf = Test2::Harness::TestFile->new(file => $f->{harness_job_end}->{abs_file}); my @to; push @to => $tf->meta('owner') if $settings->notify->email_owner; push @to => @{$settings->notify->email_fail}; return unless @to; my $text = $self->gen_text(scope => 'job', service => 'email', settings => $settings, file => $tf, tries => $tries); my $subject = "Failed test on " . hostname() . ": '" . $tf->relative . "'."; $self->_send_email($subject, $text, $settings, @to); } sub gen_email_job_text { my $self = shift; my %params = @_; my $settings = $params{settings} // croak "'settings' is required"; my $tf = $params{file} // croak "'file' is required"; my $tries = $params{tries} // 0; my $host = hostname(); my $file = $tf->relative; return join "\n\n" => grep { $_ } $settings->notify->text, "Failed test on $host: '$file'.", $tries ? ("Test was run " . (1 + $tries) . " time(s).") : (), join "\n" => @{$settings->run->links}; } sub _send_email { my $self = shift; my ($subject, $text, $settings, @to) = @_; my $mail = Email::Stuffer->to(@to); $mail->from($settings->notify->email_from); $mail->subject($subject); my $rtype = ref($text) // ''; if (!$rtype) { $mail->text_body($text); } elsif ($rtype eq 'HASH') { $mail->text_body($text->{text}) if $text->{text}; $mail->html_body($text->{html}) if $text->{html}; } else { warn "Invalid text type: '$rtype'"; } eval { $mail->send_or_die; 1 } or warn $@; } sub finish { my $self = shift; my %params = @_; my $settings = $params{settings}; my $e = $self->{+FINAL} or return; my $f = $e->facet_data or return; my $final = $f->{harness_final} or return; $self->send_run_notification_slack($final, $settings); $self->send_run_notification_email($final, $settings); } sub send_run_notification_slack { my $self = shift; my ($final, $settings) = @_; return if $settings->notify->no_batch_slack; my @to = @{$settings->notify->slack}; push @to => @{$settings->notify->slack_fail} unless $final->{pass}; my $files = ""; if ($final->{failed}) { for my $set (@{$final->{failed}}) { my $file = $set->[1]; $files = $files ? "$files\n$file" : $file; next unless $settings->notify->slack_owner; my $tf = Test2::Harness::TestFile->new(file => $file); push @to => $tf->meta('slack'); } } return unless @to; my $text = $self->gen_text( scope => 'run', service => 'slack', settings => $settings, final => $final, files => $files, ); $self->_send_slack($text, $settings, @to); } sub gen_slack_run_text { my $self = shift; my %params = @_; my $settings = $params{settings} // croak "'settings' is required"; my $final = $params{final} // croak "'final' is required"; my $files = $params{files} // ''; my $host = hostname(); return join "\n\n" => grep { $_ } ( $settings->notify->text, ($final->{pass} ? "Tests passed on $host" : "Tests failed on $host"), ($files ? $files : ()), join("\n" => map {"> <$_|$_>"} @{$settings->run->links}), ); } sub send_run_notification_email { my $self = shift; my ($final, $settings) = @_; return if $settings->notify->no_batch_email; my @to = @{$settings->notify->email}; push @to => @{$settings->notify->email_fail} unless $final->{pass}; my $files = ""; if ($final->{failed}) { for my $set (@{$final->{failed}}) { my $file = $set->[1]; $files = $files ? "$files\n$file" : $file; next unless $settings->notify->email_owner; my $tf = Test2::Harness::TestFile->new(file => $file); push @to => $tf->meta('owner'); } } return unless @to; my $subject = $self->gen_text( scope => 'run', service => 'email_subject', settings => $settings, final => $final, files => $files, ); my $text = $self->gen_text( scope => 'run', service => 'email', settings => $settings, final => $final, files => $files, subject => $subject, ); $self->_send_email($subject, $text, $settings, @to); } sub gen_email_subject_run_text { my $self = shift; my %params = @_; my $final = $params{final} // croak "'final' is required"; my $host = hostname(); return $final->{pass} ? "Tests passed on $host" : "Tests failed on $host"; } sub gen_email_run_text { my $self = shift; my %params = @_; my $subject = $params{subject} // $self->gen_text(%params, service => 'email_subject'); my $settings = $params{settings} // croak "'settings' is required"; my $final = $params{final} // croak "'final' is required"; my $files = $params{files} // ''; return join "\n\n" => grep { $_ } ( $settings->notify->text, $subject, ($files ? $files : ()), join("\n" => @{$settings->run->links}), ); } sub gen_text { my $self = shift; my %params = @_; my $scope = $params{scope} or croak "'scope' is required"; my $service = $params{service} or croak "'service' is required"; my $settings = $params{settings} or croak "'settings' is required"; my $meth = "gen_${service}_${scope}_text"; if (my $tm = $self->text_mod($settings)) { return $tm->$meth(%params, notify => $self) if $tm->can($meth); } if ($self->can($meth)) { my $text = $self->$meth(%params); my $mod = $settings->notify->text_module; $text = <<" EOT" if $self->{+TEXT_MOD_FAIL} && $service !~ m/subject/i; ******************************************************************************* There was an error loading the text generation module '$mod'. Because of this error the default notification text has been used. The error encountered was: $self->{+TEXT_MOD_FAIL} ******************************************************************************* $text EOT return $text; } confess "No notification text method '$meth'"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Plugin::Notify - Plugin to send email and/or slack notifications =head1 DESCRIPTION This plugin is used for sending email and/or slack notifications from yath. =head1 SYNOPSIS =head2 IN A TEST #!/usr/bin/perl use Test2::V0; # HARNESS-META owner author@example.com # HARNESS-META slack #slack_channel # HARNESS-META slack #slack_user You can use the C<# HARNESS-META owner EMAIL_ADDRESS> to specify an "owner" email address. You can use the C<# HARNESS-META slack USER/CHANNEL> to specify a slack user or channel that owns the test. =head2 RUNNING WITH NOTIFICATIONS ENABLED $ yath test -pNotify ... Also of note, most of the time you can just specify the notification options you want and the plugin will load as needed as long as C<--no-scan-plugins> was not specified. =head3 EMAIL $ yath test --notify-email-owner --notify-email-from user@example.com --notify-email-fail fixer@example.com =head3 SLACK A slack hooks url is always needed for slack to work. $ yath test --notify-slack-url https://hooks.slack.com/... --notify-slack-fail '#foo' --notify-slack-owner =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Plugin/YathUI.pm0000644000175000017500000002505615012417054021433 0ustar exodistexodistpackage App::Yath::Plugin::YathUI; use strict; use warnings; our $VERSION = '1.000158'; use File::Spec; use Test2::Harness::Util qw/read_file mod2file looks_like_uuid/; use Test2::Harness::Util::JSON qw/decode_json/; use App::Yath::Options; use parent 'App::Yath::Plugin'; sub can_log { my ($option, $options) = @_; return 1 if $options->included->{'App::Yath::Options::Logging'}; return 0; } sub can_finder { my ($option, $options) = @_; return 1 if $options->included->{'App::Yath::Options::Finder'}; return 0; } option_group {prefix => 'yathui', category => "YathUI Options"} => sub { option url => ( type => 's', alt => ['uri'], description => "Yath-UI url", long_examples => [" http://my-yath-ui.com/..."], ); option api_key => ( type => 's', description => "Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user" ); option project => ( type => 's', description => "The Yath-UI project for your test results", ); option mode => ( type => 's', default => 'qvfd', description => "Set the upload mode (default 'qvfd')", long_examples => [ ' summary', ' qvf', ' qvfd', ' complete', ], ); option retry => ( type => 'c', description => "How many times to try an operation before giving up", default => 0, ); option grace => ( description => "If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going.", default => 0, ); option durations => ( description => "Poll duration data from Yath-UI to help order tests efficiently", default => 0, applicable => \&can_finder, ); option coverage => ( description => "Poll coverage data from Yath-UI to determine what tests should be run for changed files", default => 0, applicable => \&can_finder, ); # TODO # option median_durations => ( # type => 'b', # description => "Get median duration data", # default => 0, # ); option medium_duration => ( type => 's', description => "Minimum duration length (seconds) before a test goes from SHORT to MEDIUM", long_examples => [' 5'], default => 5, ); option long_duration => ( type => 's', description => "Minimum duration length (seconds) before a test goes from MEDIUM to LONG", long_examples => [' 10'], default => 10, ); option upload => ( description => "Upload the log to Yath-UI", default => 0, applicable => \&can_log, ); post -1 => sub { my %params = @_; my $settings = $params{settings}; my $options = $params{options}; my $has_finder = $options->included->{'App::Yath::Options::Finder'}; my $has_logger = $options->included->{'App::Yath::Options::Logging'}; my $has_durations = $has_finder && $settings->yathui->durations; my $has_upload = $has_logger && $settings->yathui->upload; my $has_coverage = $has_finder && $settings->yathui->coverage; return unless $has_durations || $has_upload || $has_coverage; my $url = $settings->yathui->url or die "'--yathui-url URL' is required to use durations, coverage, or upload a log"; my $project = $settings->yathui->project or die "'--yathui-project NAME' is required to use durations, coverage, or upload a log"; my $grace = $settings->yathui->grace; $url =~ s{/+$}{}g; if ($has_upload) { $settings->logging->field(log => 1); $settings->logging->field(bzip2 => 1); } if ($has_coverage) { my $curl = join '/' => ($url, 'coverage', $project); $settings->cover->field(($grace ? 'maybe_from' : 'from'), $curl); } if ($has_durations) { my $med = $settings->yathui->medium_duration; my $long = $settings->yathui->long_duration; my $durl = join '/' => ($url, 'durations', $project, $med, $long); $settings->finder->field(($grace ? 'maybe_durations' : 'durations'), $durl); } return; }; }; sub grab_rerun { my $this = shift; my ($rerun, %params) = @_; return (0) if $rerun =~ m/\.jsonl(\.gz|\.bz2)?/; my $settings = $params{settings}; my $mode_hash = $params{mode_hash}; my $path; if ($rerun eq '1') { my $project = $settings->yathui->project or return (0); my $user = $settings->yathui->user // $ENV{USER}; $path = "$project/$user"; print "Re-run requested with no paremeters, ${ \__PACKAGE__ } querying YathUI (web request) for last run matching $path...\n"; # API Qwerk :-/ $path .= '/0'; } elsif (looks_like_uuid($rerun)) { $path = "$rerun"; print "Re-run requested with UUID, ${ \__PACKAGE__ } querying YathUI (web request) for matching run, or latest run from project or user matching the UUID\n"; } else { return (0); } $path = "rerun/$path"; my ($ok, $res, $data) = $this->_request($settings, $path, {json => 1}); if (!$ok) { print "Error getting a re-run data from yathui: $data...\n"; return (1); } return (1, $data); } sub _request { my $this = shift; my ($settings, $path, $payload) = @_; my $url = $settings->yathui->url; $url =~ s{/+$}{}g; $url = join "/" => ($url, $path); my %fields; for my $field (qw/project api_key mode/) { my $val = $settings->yathui->field($field) or next; $fields{$field} = $val; } require HTTP::Tiny; eval { require HTTP::Tiny::Multipart; 1 } or die "To use --yathui-* you must install HTTP::Tiny::Multipart.\n"; my $res; for (0 .. $settings->yathui->retry) { my $http = HTTP::Tiny->new; $res = $http->post_multipart( $url => { headers => {'Content-Type' => 'application/json'}, %fields, %$payload, }, ); next unless $res; last if $res->{status} eq '200'; } my ($ok, $msg); if ($res && $res->{status} eq '200') { my $data; $ok = eval { $data = decode_json($res->{content}); 1 }; if ($ok) { return (1, $res, $data); } else { $msg = $@; } } else { if ($res) { $msg = "Server responded with " . $res->{status} . ":\n" . ($res->{content} // 'NO CONTENT'); } else { $msg = "Failed to upload yathui log, no response object"; } } return (0, $res, $msg); } sub finish { my $this = shift; my %params = @_; my $settings = $params{settings}; return unless $settings->yathui->upload; my $log_file = $settings->logging->log_file; my ($filename) = reverse File::Spec->splitpath($log_file); my ($ok, $res, $data) = $this->_request( 'upload', { log_file => { filename => $filename, content => read_file($log_file, no_decompress => 1), content_type => 'application/x-bzip2', }, action => 'Upload Log', json => 1, } ); die "Error connecting to YathUI: $data\n" unless $ok; my $msg; if ($data->{errors} && @{$data->{errors}}) { $ok = 0; $msg = join "\n" => (@{$data->{errors}}); } elsif ($data->{messages}) { $ok = 1; my $url = $settings->yathui->url; $url =~ s{/+$}{}g; $msg = join "\n" => ( @{$data->{messages}}, $data->{run_id} ? ("YathUI run url: " . join '/' => ($url, 'run', $data->{run_id})) : (), ); } else { $ok = 0; $msg = "No messages recieved"; } chomp($msg); $msg = "YathUI Upload: $msg"; if ($ok) { print "\n$msg\n"; } else { if ($settings->yathui->grace) { warn $msg; } else { die $msg; } } return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Plugin::YathUI - Plugin to interact with a YathUI server =head1 DESCRIPTION If you have a Yath-UI L server, you can use this module to have yath automatically upload logs or retrieve durations data =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Plugin/Cover.pm0000644000175000017500000003700615012417054021344 0ustar exodistexodistpackage App::Yath::Plugin::Cover; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Harness::Util qw/clean_path mod2file/; use Test2::Harness::Util::JSON qw/encode_json stream_json_l/; use Test2::Harness::Util::UUID qw/gen_uuid/; use parent 'App::Yath::Plugin'; use Test2::Harness::Util::HashBase qw/-aggregator -no_aggregate +metrics +outfile/; use App::Yath::Options; option_group {prefix => 'cover', category => "Cover Options"} => sub { post \&post_process; option types => ( alt => ['cover-type'], type => 'm', default => sub { [qw/pl pm/] }, ); option dirs => ( alt => ['cover-dir'], type => 'm', default => sub { ['lib'] }, action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; push @$$slot => glob($norm); }, ); option exclude_private => ( type => 'b', default => 0, description => "", ); option files => ( type => 'b', description => "Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference)", ); option metrics => ( type => 'b', description => '', ); option write => ( type => 'd', normalize => \&clean_path, long_examples => ['', '=coverage.jsonl', '=coverage.json'], description => "Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files).", action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; return $$slot = clean_path("coverage.jsonl") if $raw eq '1'; return $$slot = $norm; }, ); option aggregator => ( alt => ['cover-agg'], type => 's', long_examples => [' ByTest', ' ByRun', ' +Custom::Aggregator'], description => 'Choose a custom aggregator subclass', normalize => sub { my ($agg) = @_; return $agg if $agg =~ s/^\+//; return "Test2::Harness::Log::CoverageAggregator::$agg"; }, ); option class => ( type => 's', description => 'Choose a Test2::Plugin::Cover subclass', default => 'Test2::Plugin::Cover', ); option manager => ( type => 's', description => "Coverage 'from' manager to use when coverage data does not provide one", long_examples => [ ' My::Coverage::Manager'], applicable => \&changes_applicable, ); option from_type => ( type => 's', description => 'File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run.', long_examples => [' json', ' jsonl', ' log' ], ); option maybe_from_type => ( type => 's', 'description' => 'Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect', long_examples => [' json', ' jsonl', ' log' ], ); option from => ( type => 's', description => "This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid.", long_examples => [' path/to/log.jsonl', ' http://example.com/coverage', ' path/to/coverage.jsonl'] ); option maybe_from => ( type => 's', description => "This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid.", long_examples => [' path/to/log.jsonl', ' http://example.com/coverage', ' path/to/coverage.jsonl'] ); }; sub changes_applicable { my ($option, $options) = @_; # Cannot use this options with projects return 0 if $options->command_class && $options->command_class->isa('App::Yath::Command::projects'); return 1; } sub spawn_args { my $self = shift; my ($settings) = @_; return () unless $settings->cover->files || $settings->cover->metrics || $settings->cover->write; my $class = $settings->cover->class; return ('-M' . $class . '=disabled,1'); } sub post_process { my %params = @_; my $settings = $params{settings}; my $cover = $settings->cover; if ($cover->files || $cover->write || $cover->metrics) { my $cover_class = $cover->class // 'Test2::Plugin::Cover'; eval { require(mod2file($cover_class)); 1 } or die "Could not enable file coverage, could not load '$cover_class': $@"; push @{$settings->run->load_import->{'@'}} => $cover_class; $settings->run->load_import->{$cover_class} = []; } } sub annotate_event { my $self = shift; return if $self->{+NO_AGGREGATE}; my ($e, $settings) = @_; unless ($self->{+AGGREGATOR}) { my $do_cover = $settings->cover->files; my $file = $settings->cover->write; my $metrics = $settings->cover->metrics; unless ($file || $metrics || $do_cover) { $self->{+NO_AGGREGATE} = 1; return; } my $agg = $settings->cover->aggregator; if (!$agg) { if ($file) { if ($file =~ m/\.json$/) { $agg = 'Test2::Harness::Log::CoverageAggregator::ByRun'; } elsif ($file =~ m/\.jsonl$/) { $agg = 'Test2::Harness::Log::CoverageAggregator::ByTest'; } } else { $agg = 'Test2::Harness::Log::CoverageAggregator::ByTest'; } } my $encode; if ($agg eq 'Test2::Harness::Log::CoverageAggregator::ByRun') { $encode = \&encode_json; } elsif ($agg eq 'Test2::Harness::Log::CoverageAggregator::ByTest') { $encode = sub { encode_json($_[0]) . "\n" }; } require(mod2file($agg)); $self->{+AGGREGATOR} = $agg->new( $file ? (file => $file) : (), $encode ? (encode => $encode) : (), ); } my $fd = $e->{facet_data}; my @out; if ($fd->{coverage} || $fd->{harness_job_end} || $fd->{harness_job_start}) { if (my $list = $self->{+AGGREGATOR}->process_event($e)) { die "Aggregator flushed without a job end!" unless $fd->{harness_job_end}; die "Aggregator flushed more than 1 job!" unless @$list == 1; push @out => (job_coverage => {details => 'Job Coverage', manager => $list->[0]->{manager}, files => $list->[0]->{files}, test => $list->[0]->{test}}); } } if ($fd->{harness_final}) { my $cover = $settings->cover; my $aggregator = $self->{+AGGREGATOR} or return; my $metrics; $metrics = $self->metrics($settings) if $cover->metrics; my $final = $aggregator->finalize(); my $percentages = $self->_percentages($metrics); my $raw = join ", ", map { "$_->[0]: $_->[2]/$_->[1] ($_->[3])" } @$percentages; my $details = join ", ", map { "$_->[0] $_->[3]" } @$percentages; $details = "coverage metrics" unless length $details; push @out => ( run_fields => [ {name => 'coverage', details => $details, data => $metrics, $raw ? (raw => $raw) : ()}, ], ); push @out => ( run_coverage => { details => 'Run Coverage', files => $final->[0]->{files}, testmeta => $final->[0]->{testmeta}, }, ) if $final && @$final; } return @out; } sub metrics { my $self = shift; my ($settings) = @_; my $cover = $settings->cover; return unless $cover->metrics; my $aggregator = $self->{+AGGREGATOR}; return $self->{+METRICS} //= $aggregator->build_metrics( dirs => $cover->dirs, types => $cover->types, exclude_private => $cover->exclude_private, ); } sub _percentages { my $self = shift; my ($metrics) = @_; return unless $metrics; my @out; for my $metric (sort keys %$metrics) { next if $metric eq 'untested'; my $data = $metrics->{$metric} or next; my ($total, $tested) = @{$data}{qw/total tested/}; push @out => [$metric, $total, $tested, $total ? (int(($tested / $total) * 100) . '%') : '100%']; } return \@out; } sub finalize { my $self = shift; my ($settings) = @_; my $cover = $settings->cover; my $file = $cover->write; my $metrics = $cover->metrics; return unless $file || $metrics; print "\nCoverage:\n"; my $aggregator = $self->{+AGGREGATOR}; if ($metrics) { my $data = $self->metrics($settings); require Term::Table; my $table = Term::Table->new( header => [qw/METRIC TOTAL TESTED PERCENTAGE/], rows => $self->_percentages($data), ); print map { "$_\n" } $table->render; } print "Wrote coverage file: $file\n" if $file; print "\n"; } sub _deduce_content_type { my ($path, $type) = @_; if ($type) { if ($type eq 'json') { return { content_type => 'application/json', parser => 'json', format => $type, }; } elsif ($type eq 'jsonl' || $type eq 'log') { return { content_type => 'application/jsonl', parser => 'jsonl', format => $type, }; } } if ($path =~ m/\.jsonl/) { return { content_type => 'application/jsonl', parser => 'jsonl', format => undef, }; } if ($path =~ m/\.json/) { return { content_type => 'application/json', parser => 'json', format => undef, }; } return {}; } sub get_coverage_tests { my $self = shift; my ($settings, $changes) = @_; my $cover = $settings->cover; my $from = $cover->from; my $maybe = $cover->maybe_from; return unless $from || $maybe; if ($maybe) { my $type_data = $self->_deduce_content_type($maybe, $cover->maybe_from_type); my @out; my $ok = eval { @out = $self->_get_coverage_tests($settings, $changes, $maybe, $type_data); 1 }; my $err = $@; return @out if $ok; warn "Could not get coverage from '$maybe', continuing anyway... error was: $err"; } return $self->_get_coverage_tests($settings, $changes, $from) if $from; return; } sub _get_coverage_tests { my $self = shift; my ($settings, $changes, $source, $type_data) = @_; my @out; stream_json_l( $source => sub { push @out => $self->coverage_handler($settings, $changes, $type_data, @_) }, $type_data->{content_type} ? (http_args => [{headers => {'Content-Type' => $type_data->{content_type}}}]) : (), ); return @out; } sub coverage_handler { my $self = shift; my ($settings, $changes, $type_data, $set, $res) = @_; return unless $set; my ($agg, $data); if (my $fd = $set->{facet_data}) { if ($data = $fd->{job_coverage}) { require 'Test2/Harness/Log/CoverageAggregator/ByTest.pm' unless $INC{'Test2/Harness/Log/CoverageAggregator/ByTest.pm'}; $agg = 'Test2::Harness::Log::CoverageAggregator::ByTest'; } elsif($data = $fd->{run_coverage}) { require 'Test2/Harness/Log/CoverageAggregator/ByRun.pm' unless $INC{'Test2/Harness/Log/CoverageAggregator/ByRun.pm'}; $agg = 'Test2::Harness::Log::CoverageAggregator::ByRun'; } else { return; } } else { $data = $set; $agg = $set->{aggregator} // return; my $aggfile = mod2file($agg); require($aggfile) unless $INC{$aggfile}; } return $agg->get_coverage_tests($settings, $changes, $data); } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Plugin::Cover - Plugin to collect and report basic coverage data =head1 DESCRIPTION Simple coverage data, file and sub coverage only. Use L if you want deep coverage stats. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Plugin/Git.pm0000644000175000017500000001173415012417054021011 0ustar exodistexodistpackage App::Yath::Plugin::Git; use strict; use warnings; our $VERSION = '1.000158'; use IPC::Cmd qw/can_run/; use Test2::Harness::Util::IPC qw/run_cmd/; use parent 'App::Yath::Plugin'; use App::Yath::Options; option_group {prefix => 'git', category => "Git Options"} => sub { option change_base => ( type => 's', description => "Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base.", long_examples => [" master", " HEAD^", " df22abe4"], ); }; my $GIT_CMD = can_run('git'); sub git_cmd { $ENV{GIT_COMMAND} || $GIT_CMD } sub git_output { my $class = shift; my (@args) = @_; my $cmd = $class->git_cmd or return sub {()}; my ($rh, $wh, $irh, $iwh); pipe($rh, $wh) or die "No pipe: $!"; pipe($irh, $iwh) or die "No pipe: $!"; my $pid = run_cmd(stderr => $iwh, stdout => $wh, command => [$cmd, @args]); close($wh); close($iwh); $rh->blocking(1); $irh->blocking(0); my $waited = 0; return sub { my $line = <$rh>; return $line if defined $line; unless ($waited++) { local $?; waitpid($pid, 0); print STDERR <$irh> if $?; close($irh); # Try again $line = <$rh>; return $line if defined $line; } close($rh); return; }; } sub inject_run_data { my $class = shift; my %params = @_; my $meta = $params{meta}; my $fields = $params{fields}; my $long_sha = $ENV{GIT_LONG_SHA}; my $short_sha = $ENV{GIT_SHORT_SHA}; my $status = $ENV{GIT_STATUS}; my $branch = $ENV{GIT_BRANCH}; my @sets = ( [\$long_sha, 'rev-parse', 'HEAD'], [\$short_sha, 'rev-parse', '--short', 'HEAD'], [\$status, 'status', '-s'], [\$branch, 'rev-parse', '--abbrev-ref', 'HEAD'], ); for my $set (@sets) { my ($var, @args) = @$set; next if $$var; # Already set my $output = $class->git_output(@args); my @lines; while (my $line = $output->()) { push @lines => $line; } chomp($$var = join "\n" => @lines); } return unless $long_sha; $meta->{git}->{sha} = $long_sha; $meta->{git}->{status} = $status if $status; if ($branch) { $meta->{git}->{branch} = $branch; my $short = length($branch) > 20 ? substr($branch, 0, 20) : $branch; push @$fields => {name => 'git', details => $short, raw => $branch, data => $meta->{git}}; } else { $short_sha ||= substr($long_sha, 0, 16); push @$fields => {name => 'git', details => $short_sha, raw => $long_sha, data => $meta->{git}}; } return; } sub changed_diff { my $class = shift; my ($settings) = @_; $class->_changed_diff($settings->git->change_base); } sub _changed_diff { my $class = shift; my ($base) = @_; my $cmd = $class->git_cmd or return; my $from = 'HEAD'; if ($base) { $from .= "^" while system($cmd => 'merge-base', '--is-ancestor', $from, $base); return $class->_diff_from($from); } my @files = $class->_diff_from($from); return @files if @files; return $class->_diff_from("${from}^"); } sub _diff_from { my $class = shift; my ($from) = @_; my $cmd = $class->git_cmd or return; return (line_sub => $class->git_output('diff', '-U1000000', '-W', '--minimal', $from)); } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Plugin::Git - Plugin to attach git data to a test run. =head1 DESCRIPTION This plugin will attach git data to your test logs if any is available. =head1 SYNOPSIS $ yath test -pGit ... =head1 READING THE DATA The data is attached to the 'run' entry in the log file. This can be seen directly in the json data. The data is also easily accessible with L. The data will include the long sha, short sha, branch name, and a brief status. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/0000755000175000017500000000000015012417054020042 5ustar exodistexodistTest2-Harness-1.000158/lib/App/Yath/Command/collector.pm0000644000175000017500000003146715012417054022401 0ustar exodistexodistpackage App::Yath::Command::collector; use strict; use warnings; our $VERSION = '1.000158'; use File::Spec; use App::Yath::Util qw/isolate_stdout/; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Harness::Util qw/mod2file/; use Test2::Harness::Run; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub internal_only { 1 } sub summary { "For internal use only" } sub name { 'collector' } sub run { my $self = shift; my ($collector_class, $dir, $run_id, $runner_pid, %args) = @{$self->{+ARGS}}; my $name = 'yath-collector'; $name = "$args{procname_prefix}-${name}" if $args{procname_prefix}; $0 = $name; my $fh = isolate_stdout(); my $settings = Test2::Harness::Settings->new(File::Spec->catfile($dir, 'settings.json')); require(mod2file($collector_class)); my $run = Test2::Harness::Run->new(%{decode_json()}); my $collector = $collector_class->new( %args, settings => $settings, workdir => $dir, run_id => $run_id, runner_pid => $runner_pid, run => $run, # as_json may already have the json form of the event cached, if so # we can avoid doing an extra call to encode_json action => sub { print $fh defined($_[0]) ? $_[0]->as_json . "\n" : "null\n"; }, ); local $SIG{PIPE} = 'IGNORE'; my $ok = eval { $collector->process(); 1 }; my $err = $@; eval { print $fh "null\n"; 1 } or warn $@; die $err unless $ok; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::collector - For internal use only =head1 DESCRIPTION No Description =head1 USAGE $ yath [YATH OPTIONS] collector [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/resources.pm0000644000175000017500000004766415012417054022433 0ustar exodistexodistpackage App::Yath::Command::resources; use strict; use warnings; our $VERSION = '1.000158'; use Term::Table(); use File::Spec(); use Time::HiRes qw/sleep/; use App::Yath::Util qw/find_pfile/; use App::Yath::Options; use Test2::Harness::Runner::State; use Test2::Harness::Util::File::JSON(); use Test2::Harness::Util::Queue(); use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw/+state/; include_options( 'App::Yath::Options::Debug', 'App::Yath::Options::Runner', ); sub group { 'state' } sub summary { "View the state info for a test runner" } sub cli_args { "" } sub description { return <<" EOT"; A look at the state and resources used by a runner. EOT } sub pfile_params { (no_fatal => 1) } sub newest { my ($a, $b) = @_; return $a unless $b; return $b unless $a; my @as = stat($a); my @bs = stat($b); return $a if $as[9] > $bs[9]; return $b; } sub state { my $self = shift; return $self->{+STATE} if $self->{+STATE}; my $info_file; opendir(my $dh, "./") or die "Could not open current dir: $!"; for my $file (readdir($dh)) { next unless $file =~ m{^\.test_info\.\S+\.json$}; $info_file = newest($info_file, "./$file"); } my $pfile = find_pfile($self->settings, no_fatal => 1); if (my $use = newest($info_file, $pfile)) { if ($info_file) { my $data = Test2::Harness::Util::File::JSON->new(name => $info_file)->read; return $self->{+STATE} = Test2::Harness::Runner::State->new(%$data, observe => 1); } if (my $pfile = find_pfile($self->settings, no_fatal => 1)) { my $data = Test2::Harness::Util::File::JSON->new(name => $pfile)->read(); my $workdir = $data->{dir}; my $settings = Test2::Harness::Util::File::JSON->new(name => "$workdir/settings.json")->read(); return $self->{+STATE} = Test2::Harness::Runner::State->new( observe => 1, job_count => $settings->{runner}->{job_count} // 1, workdir => $data->{dir}, ); } } return; } sub shared { my $self = shift; my $shared; eval { require Test2::Harness::Runner::Resource::SharedJobSlots; $shared = Test2::Harness::Runner::Resource::SharedJobSlots->new( settings => $self->settings, ); 1; }; return $shared; } sub run { my $self = shift; my $res; if(my $state = $self->state) { my @list; $res = sub { unless (@list) { $state->poll; @list = (@{$state->resources}, undef); } return shift @list; }; } elsif (my $shared = $self->shared) { my $alt = 0; $res = sub { if ($alt) { $alt = 0; return undef; } $alt = 1; return $shared; }; } die "No persistent runner, no running test, and no shared resources found\n" unless $res; while (1) { my @out = ( "\r\e[2J\r\e[1;1H", "\n==== Resource state ====\n", ); while (my $resource = $res->()) { my @lines = $resource->status_lines; next unless @lines; push @out => ( "\nResource: " . ref($resource) . "\n", join "\n" => @lines, ); } push @out => "\n\n"; print @out; sleep 0.1; } return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::resources - View the state info for a test runner =head1 DESCRIPTION A look at the state and resources used by a runner. =head1 USAGE $ yath [YATH OPTIONS] resources [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 Runner Options =over 4 =item --abort-on-bail =item --no-abort-on-bail Abort all testing if a bail-out is encountered (default: on) =item --blib =item -b =item --no-blib (Default: include if it exists) Include 'blib/lib' and 'blib/arch' in your module path =item --cover =item --cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --no-cover Use Devel::Cover to calculate test coverage. This disables forking. If no args are specified the following are used: -silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --dump-depmap =item --no-dump-depmap When using staged preload, dump the depmap for each stage as json files =item --event-timeout SECONDS =item --et SECONDS =item --no-event-timeout Kill test if no output is received within timeout period. (Default: 60 seconds). Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. This prevents a hung test from running forever. =item --include ARG =item --include=ARG =item -I ARG =item -I=ARG =item --no-include Add a directory to your include paths Can be specified multiple times =item --job-count 4 =item --job-count 8:2 =item --jobs 4 =item --jobs 8:2 =item -j4 =item -j8:2 =item --no-job-count Set the number of concurrent jobs to run. Add a :# if you also wish to designate multiple slots per test. 8:2 means 8 slots, but each test gets 2 slots, so 4 tests run concurrently. Tests can find their concurrency assignemnt in the "T2_HARNESS_MY_JOB_CONCURRENCY" environment variable. Can also be set with the following environment variables: C, C, C =item --lib =item -l =item --no-lib (Default: include if it exists) Include 'lib' in your module path =item --nytprof =item --no-nytprof Use Devel::NYTProf on tests. This will set addpid=1 for you. This works with or without fork. =item --post-exit-timeout SECONDS =item --pet SECONDS =item --no-post-exit-timeout Stop waiting post-exit after the timeout period. (Default: 15 seconds) Some tests fork and allow the parent to exit before writing all their output. If Test2::Harness detects an incomplete plan after the test exits it will monitor for more events until the timeout period. Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. =item --preload-threshold ARG =item --preload-threshold=ARG =item --Pt ARG =item --Pt=ARG =item -W ARG =item -W=ARG =item --no-preload-threshold Only do preload if at least N tests are going to be run. In some cases a full preload takes longer than simply running the tests, this lets you specify a minimum number of test jobs that will be run for preload to happen. This has no effect for a persistent runner. The default is 0, and it means always preload. =item --preloads ARG =item --preloads=ARG =item --preload ARG =item --preload=ARG =item -P ARG =item -P=ARG =item --no-preloads Preload a module before running tests Can be specified multiple times =item --resource Port =item --resource +Test2::Harness::Runner::Resource::Port =item -R Port =item --no-resource Use a resource module to assign resource assignments to individual tests Can be specified multiple times =item --runner-id ARG =item --runner-id=ARG =item --no-runner-id Runner ID (usually a generated uuid) =item --shared-jobs-config .sharedjobslots.yml =item --shared-jobs-config relative/path/.sharedjobslots.yml =item --shared-jobs-config /absolute/path/.sharedjobslots.yml =item --no-shared-jobs-config Where to look for a shared slot config file. If a filename with no path is provided yath will search the current and all parent directories for the name. =item --slots-per-job 2 =item -x2 =item --no-slots-per-job This sets the number of slots each job will use (default 1). This is normally set by the ':#' in '-j#:#'. Can also be set with the following environment variables: C =item --switch ARG =item --switch=ARG =item -S ARG =item -S=ARG =item --no-switch Pass the specified switch to perl for each test. This is not compatible with preload. Can be specified multiple times =item --tlib =item --no-tlib (Default: off) Include 't/lib' in your module path =item --unsafe-inc =item --no-unsafe-inc perl is removing '.' from @INC as a security concern. This option keeps things from breaking for now. Can also be set with the following environment variables: C =item --use-fork =item --fork =item --no-use-fork (default: on, except on windows) Normally tests are run by forking, which allows for features like preloading. This will turn off the behavior globally (which is not compatible with preloading). This is slower, it is better to tag misbehaving tests with the '# HARNESS-NO-PRELOAD' comment in their header to disable forking only for those tests. Can also be set with the following environment variables: C, C, C, C, C =item --use-timeout =item --timeout =item --no-use-timeout (default: on) Enable/disable timeouts =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/speedtag.pm0000644000175000017500000004274315012417054022206 0ustar exodistexodistpackage App::Yath::Command::speedtag; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Harness::Util::File::JSONL; use App::Yath::Options; use Cwd qw/getcwd/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw/-log_file -max_short -max_medium/; use Test2::Harness::Util qw/clean_path/; include_options( 'App::Yath::Options::Debug', ); option_group {prefix => 'speedtag', category => 'speedtag options'} => sub { option generate_durations_file => ( type => 'd', alt => ['durations', 'duration'], description => "Write out a duration json file, if no path is provided 'duration.json' will be used. The .json extension is added automatically if omitted.", long_examples => ['', '=/path/to/durations.json'], normalize => \&normalize_duration, action => \&duration_action, ); option pretty => ( description => "Generate a pretty 'durations.json' file when combined with --generate-durations-file. (sorted and multilines)", default => 0, ); }; sub group { 'log' } sub summary { "Tag tests with duration (short medium long) using a source log" } sub cli_args { "[--] event_log.jsonl[.gz|.bz2] max_short_duration_seconds max_medium_duration_seconds" } sub description { return <<" EOT"; This command will read the test durations from a log and tag/retag all tests from the log based on the max durations for each type. EOT } sub init { my $self = shift; $self->{+MAX_SHORT} //= 15; $self->{+MAX_MEDIUM} //= 30; } sub normalize_duration { my $val = shift; return $val if $val eq '1'; $val =~ s/\.json$//g; $val .= '.json'; return clean_path($val); } sub duration_action { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; return $$slot = clean_path($norm) unless $norm eq '1'; return if $$slot; return $$slot = clean_path('durations.json'); } sub run { my $self = shift; my $settings = $self->settings; my $args = $self->args; shift @$args if @$args && $args->[0] eq '--'; my $initial_dir = clean_path(getcwd()); $self->{+LOG_FILE} = shift @$args or die "You must specify a log file"; die "'$self->{+LOG_FILE}' is not a valid log file" unless -f $self->{+LOG_FILE}; die "'$self->{+LOG_FILE}' does not look like a log file" unless $self->{+LOG_FILE} =~ m/\.jsonl(\.(gz|bz2))?$/; $self->{+MAX_SHORT} = shift @$args if @$args; $self->{+MAX_MEDIUM} = shift @$args if @$args; die "max short duration must be an integer, got '$self->{+MAX_SHORT}'" unless $self->{+MAX_SHORT} && $self->{+MAX_SHORT} =~ m/^\d+$/; die "max short duration must be an integer, got '$self->{+MAX_MEDIUM}'" unless $self->{+MAX_MEDIUM} && $self->{+MAX_MEDIUM} =~ m/^\d+$/; my $stream = Test2::Harness::Util::File::JSONL->new(name => $self->{+LOG_FILE}); my $durations_file = $self->settings->speedtag->generate_durations_file; my %durations; while(1) { my @events = $stream->poll(max => 1000) or last; for my $event (@events) { my $stamp = $event->{stamp} or next; my $job_id = $event->{job_id} or next; my $f = $event->{facet_data} or next; next unless $f->{harness_job_end}; my $job = {}; $job->{file} = clean_path( $f->{harness_job_end}->{file} ) if $f->{harness_job_end} && $f->{harness_job_end}->{file}; $job->{time} = $f->{harness_job_end}->{times}->{totals}->{total} if $f->{harness_job_end} && $f->{harness_job_end}->{times}; next unless $job->{file} && $job->{time}; my $dur; if ($job->{time} < $self->{+MAX_SHORT}) { $dur = 'short'; } elsif ($job->{time} < $self->{+MAX_MEDIUM}) { $dur = 'medium'; } else { $dur = 'long'; } my $fh; unless (open($fh, '<', $job->{file})) { warn "Could not open file $job->{file} for reading\n"; next; } my @lines; my $injected; for my $line (<$fh>) { if ($line =~ m/^(\s*)#(\s*)HARNESS-(CAT(EGORY)?|DUR(ATION))-(LONG|MEDIUM|SHORT)$/i) { next if $injected++; $line = "${1}#${2}HARNESS-DURATION-" . uc($dur) . "\n"; } push @lines => $line; } unless ($injected) { my $new_line = "# HARNESS-DURATION-" . uc($dur) . "\n"; my @header; while (@lines && $lines[0] =~ m/^(#|use\s|package\s)/) { push @header => shift @lines; } unshift @lines => (@header, $new_line); } close($fh); unless (open($fh, '>', $job->{file})) { warn "Could not open file $job->{file} for writing\n"; next; } print $fh @lines; close($fh); if ( $durations_file ) { my $tfile = $job->{file}; $tfile =~ s{^\Q$initial_dir\E/+}{}; $durations{ $tfile } = uc( $dur ); } print "Tagged '$dur': $job->{file}\n"; } } if ( $durations_file ) { my $jfile = Test2::Harness::Util::File::JSON->new(name => $durations_file, pretty => $self->settings->speedtag->pretty ); $jfile->write( \%durations ); } return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::speedtag - Tag tests with duration (short medium long) using a source log =head1 DESCRIPTION This command will read the test durations from a log and tag/retag all tests from the log based on the max durations for each type. =head1 USAGE $ yath [YATH OPTIONS] speedtag [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head3 speedtag options =over 4 =item --generate-durations-file =item --generate-durations-file=/path/to/durations.json =item --durations =item --durations=/path/to/durations.json =item --duration =item --duration=/path/to/durations.json =item --no-generate-durations-file Write out a duration json file, if no path is provided 'duration.json' will be used. The .json extension is added automatically if omitted. =item --pretty =item --no-pretty Generate a pretty 'durations.json' file when combined with --generate-durations-file. (sorted and multilines) =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/projects.pm0000644000175000017500000010250015012417054022227 0ustar exodistexodistpackage App::Yath::Command::projects; use strict; use warnings; our $VERSION = '1.000158'; use parent 'App::Yath::Command::test'; use Test2::Harness::Util::HashBase; sub summary { "Run tests for multiple projects" } sub cli_args { "[--] projects_dir [::] [arguments to test scripts]" } sub description { return <<" EOT"; This command will run all the tests for each project within a parent directory. EOT } sub finder_args {(multi_project => 1)} 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::projects - Run tests for multiple projects =head1 DESCRIPTION This command will run all the tests for each project within a parent directory. =head1 USAGE $ yath [YATH OPTIONS] projects [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Collector Options =over 4 =item --max-open-jobs 18 =item --no-max-open-jobs Maximum number of jobs a collector can process at a time, if more jobs are pending their output will be delayed until the earlier jobs have been processed. (Default: double the -j value) =item --max-poll-events 1000 =item --no-max-poll-events Maximum number of events to poll from a job before jumping to the next job. (Default: 1000) =back =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used ot set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C, C =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 Runner Options =over 4 =item --abort-on-bail =item --no-abort-on-bail Abort all testing if a bail-out is encountered (default: on) =item --blib =item -b =item --no-blib (Default: include if it exists) Include 'blib/lib' and 'blib/arch' in your module path =item --cover =item --cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --no-cover Use Devel::Cover to calculate test coverage. This disables forking. If no args are specified the following are used: -silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --dump-depmap =item --no-dump-depmap When using staged preload, dump the depmap for each stage as json files =item --event-timeout SECONDS =item --et SECONDS =item --no-event-timeout Kill test if no output is received within timeout period. (Default: 60 seconds). Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. This prevents a hung test from running forever. =item --include ARG =item --include=ARG =item -I ARG =item -I=ARG =item --no-include Add a directory to your include paths Can be specified multiple times =item --job-count 4 =item --job-count 8:2 =item --jobs 4 =item --jobs 8:2 =item -j4 =item -j8:2 =item --no-job-count Set the number of concurrent jobs to run. Add a :# if you also wish to designate multiple slots per test. 8:2 means 8 slots, but each test gets 2 slots, so 4 tests run concurrently. Tests can find their concurrency assignemnt in the "T2_HARNESS_MY_JOB_CONCURRENCY" environment variable. Can also be set with the following environment variables: C, C, C =item --lib =item -l =item --no-lib (Default: include if it exists) Include 'lib' in your module path =item --nytprof =item --no-nytprof Use Devel::NYTProf on tests. This will set addpid=1 for you. This works with or without fork. =item --post-exit-timeout SECONDS =item --pet SECONDS =item --no-post-exit-timeout Stop waiting post-exit after the timeout period. (Default: 15 seconds) Some tests fork and allow the parent to exit before writing all their output. If Test2::Harness detects an incomplete plan after the test exits it will monitor for more events until the timeout period. Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. =item --preload-threshold ARG =item --preload-threshold=ARG =item --Pt ARG =item --Pt=ARG =item -W ARG =item -W=ARG =item --no-preload-threshold Only do preload if at least N tests are going to be run. In some cases a full preload takes longer than simply running the tests, this lets you specify a minimum number of test jobs that will be run for preload to happen. This has no effect for a persistent runner. The default is 0, and it means always preload. =item --preloads ARG =item --preloads=ARG =item --preload ARG =item --preload=ARG =item -P ARG =item -P=ARG =item --no-preloads Preload a module before running tests Can be specified multiple times =item --resource Port =item --resource +Test2::Harness::Runner::Resource::Port =item -R Port =item --no-resource Use a resource module to assign resource assignments to individual tests Can be specified multiple times =item --runner-id ARG =item --runner-id=ARG =item --no-runner-id Runner ID (usually a generated uuid) =item --shared-jobs-config .sharedjobslots.yml =item --shared-jobs-config relative/path/.sharedjobslots.yml =item --shared-jobs-config /absolute/path/.sharedjobslots.yml =item --no-shared-jobs-config Where to look for a shared slot config file. If a filename with no path is provided yath will search the current and all parent directories for the name. =item --slots-per-job 2 =item -x2 =item --no-slots-per-job This sets the number of slots each job will use (default 1). This is normally set by the ':#' in '-j#:#'. Can also be set with the following environment variables: C =item --switch ARG =item --switch=ARG =item -S ARG =item -S=ARG =item --no-switch Pass the specified switch to perl for each test. This is not compatible with preload. Can be specified multiple times =item --tlib =item --no-tlib (Default: off) Include 't/lib' in your module path =item --unsafe-inc =item --no-unsafe-inc perl is removing '.' from @INC as a security concern. This option keeps things from breaking for now. Can also be set with the following environment variables: C =item --use-fork =item --fork =item --no-use-fork (default: on, except on windows) Normally tests are run by forking, which allows for features like preloading. This will turn off the behavior globally (which is not compatible with preloading). This is slower, it is better to tag misbehaving tests with the '# HARNESS-NO-PRELOAD' comment in their header to disable forking only for those tests. Can also be set with the following environment variables: C, C, C, C, C =item --use-timeout =item --timeout =item --no-use-timeout (default: on) Enable/disable timeouts =back =head3 Workspace Options =over 4 =item --clear =item -C =item --no-clear Clear the work directory if it is not already empty =item --tmp-dir ARG =item --tmp-dir=ARG =item --tmpdir ARG =item --tmpdir=ARG =item -t ARG =item -t=ARG =item --no-tmp-dir Use a specific temp directory (Default: use system temp dir) Can also be set with the following environment variables: C, C, C, C, C, C =item --workdir ARG =item --workdir=ARG =item -w ARG =item -w=ARG =item --no-workdir Set the work directory (Default: new temp directory) Can also be set with the following environment variables: C, C =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/auditor.pm0000644000175000017500000003067715012417054022064 0ustar exodistexodistpackage App::Yath::Command::auditor; use strict; use warnings; our $VERSION = '1.000158'; use File::Spec; use Scalar::Util qw/blessed/; use App::Yath::Util qw/isolate_stdout/; use Test2::Harness::Util::JSON qw/decode_json encode_json/; use Test2::Harness::Util qw/mod2file/; use Test2::Harness::Run; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub internal_only { 1 } sub summary { "For internal use only" } sub name { 'auditor' } sub run { my $self = shift; my ($auditor_class, $run_id, %args) = @{$self->{+ARGS}}; my $name = 'yath-auditor'; $name = "$args{procname_prefix}-${name}" if $args{procname_prefix}; $0 = $name; my $fh = isolate_stdout(); require(mod2file($auditor_class)); my $auditor = $auditor_class->new( %args, run_id => $run_id, action => sub { print $fh defined($_[0]) ? blessed($_[0]) ? $_[0]->as_json . "\n" : encode_json($_[0]) . "\n" : "null\n" }, ); local $SIG{PIPE} = 'IGNORE'; my $ok = eval { $auditor->process(); 1 }; my $err = $@; eval { $auditor->finish(); 1 } or warn $@; die $err unless $ok; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::auditor - For internal use only =head1 DESCRIPTION No Description =head1 USAGE $ yath [YATH OPTIONS] auditor [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/runner.pm0000644000175000017500000006114715012417054021722 0ustar exodistexodistpackage App::Yath::Command::runner; use strict; use warnings; our $VERSION = '1.000158'; use Config qw/%Config/; use File::Spec; # For some reason Filter::Util::Class breaks the STDIN filehandle. This works # around that. my $FIX_STDIN; BEGIN { require goto::file; no strict 'refs'; no warnings 'redefine'; my $int_done; my $orig = goto::file->can('filter'); *goto::file::filter = sub { local $.; my $out = $orig->(@_); seek(STDIN, 0, 0) if $FIX_STDIN; unless ($int_done++) { if (my $fifo = $ENV{YATH_INTERACTIVE}) { my $ok; for (1 .. 10) { $ok = open(STDIN, '<', $fifo); last if $ok; die "Could not open fifo ($fifo): $!"; sleep 1; } die "Could not open fifo ($fifo): $!" unless $ok; print STDERR <<' EOT'; ******************************************************************************* * YATH IS RUNNING IN INTERACTIVE MODE * * * * STDIN is comming from a fifo pipe, not a TTY! * * * * The $ENV{YATH_INTERACTIVE} var is set to the FIFO being used. * * * * VERBOSE mode has been turned on for you * * * * Only 1 test will run at a time * * * * The main yath process no longer has STDIN, so yath plugins that wait for * * input WILL BREAK. * * * * Prompts that do not end with a newline may have a 1 second delay before * * they are displayed, they will be prefixed with [INTERACTIVE] * * * * Any stdin/stdout that is printed in 2 parts without a newline and more than * * a 1 second delay will be printed with the [INTERACTIVE] prefix, if they are * * not actually a prompt you can safely ignore them. * * * * It is possible that a prompt was displayed before this message, please * * check above if your prompt appears missing. This is an IO fluke, not a bug. * * * ******************************************************************************* EOT } } return $out; }; } use Test2::Harness::IPC(); use Carp qw/confess/; use Scalar::Util qw/openhandle/; use List::Util qw/first/; use File::Path qw/remove_tree/; use Scope::Guard; use Test2::Util qw/clone_io/; use Long::Jump qw/setjump longjump/; use Test2::Harness::Util qw/mod2file write_file_atomic open_file clean_path process_includes/; use Test2::Harness::Util::IPC qw/swap_io/; use Test2::Harness::Runner::Preloader(); my @SIGNALS = grep { $_ ne 'ZERO' } split /\s+/, $Config{sig_name}; # If FindBin is installed, go ahead and load it. We do not care much about # success vs failure here. BEGIN { local $@; eval { require FindBin; FindBin->import }; } use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub internal_only { 1 } sub summary { "For internal use only" } sub name { 'runner' } sub init { confess(ref($_[0]) . " is not intended to be instantiated") } sub run { confess(ref($_[0]) . " does not implement run()") } our $RUNNER_PID; sub generate_run_sub { my $class = shift; my ($symbol, $argv, $spawn_settings) = @_; my ($dir, %args) = @$argv; $RUNNER_PID = $$; my $runner_pid = $$; my $settings = Test2::Harness::Settings->new(File::Spec->catfile($dir, 'settings.json')); my $name = $ENV{NESTED_YATH} ? 'yath-nested-runner' : 'yath-runner'; $name = $settings->debug->procname_prefix . "-${name}" if $settings->debug->procname_prefix; $0 = $name; my $cleanup = $class->cleanup($settings, \%args, $dir); my $jump = setjump "Test-Runner" => sub { local $.; my %orig_sig = %SIG; my $guard = Scope::Guard->new(sub { my %seen; for my $sig (@SIGNALS) { next if $seen{$sig}++; if (exists $orig_sig{$sig}) { $SIG{$sig} = $orig_sig{$sig}; } else { delete $SIG{$sig}; } } }); my $runner = $settings->build( runner => 'Test2::Harness::Runner', %args, dir => $dir, settings => $settings, fork_job_callback => sub { $class->launch_via_fork(@_) }, fork_spawn_callback => sub { $class->launch_spawn(@_) }, respawn_runner_callback => sub { return unless $$ == $runner_pid; longjump "Test-Runner" => 'respawn' }, ); my $exit = $runner->process(); if ($$ == $runner_pid) { $_->cleanup() for @{$runner->state->resources}; } my $complete = File::Spec->catfile($dir, 'complete'); write_file_atomic($complete, '1'); exit($exit // 1); }; die "Test runner completed, but failed to exit" unless $jump; my ($action, $job, $stage) = @$jump; if($action eq 'respawn') { print "$$ Respawning the runner...\n"; $cleanup->dismiss(1); exec($^X, $settings->harness->script, @{$spawn_settings->harness->orig_argv}); warn "exec failed!"; exit 1; } die "Invalid action: $action" if $action ne 'run_test'; if (my $chdir = $job->ch_dir) { chdir($chdir) or die "Could not chdir: $!"; } goto::file->import($job->run_file); $class->cleanup_process($job, $stage); DB::enable_profile() if $settings->runner->nytprof; } sub cleanup { my $class = shift; my ($settings, $args, $dir) = @_; my $pfile = $args->{persist} or return; my $pid = $$; return Scope::Guard->new(sub { return unless $pid == $$; unlink($pfile); remove_tree($dir, {safe => 1, keep_root => 0}) unless $settings->debug->keep_dirs; }); } sub get_stage { my $class = shift; my ($runner) = @_; return unless $runner->can('stage'); my $stage_name = $runner->stage or return; my $preloader = $runner->preloader or return; my $p = $preloader->staged or return; return $p->stage_lookup->{$stage_name}; } sub launch_spawn { my $class = shift; my ($runner, $spawn) = @_; my $pid = fork() // die $!; if ($pid) { waitpid($pid, 0); return; } require POSIX; POSIX::setsid or die "setsid: $!"; $pid = fork // die $!; exit 0 if $pid; eval { my ($wh); pipe(STDIN, $wh) or die "Could not create pipe: $!"; $pid = $class->launch_via_fork($runner, $spawn); if ($pid) { open(my $fh, '>>', $spawn->{task}->{ipcfile}) or die "Could not open pidfile: $!"; print $fh "$$\n$pid\n" . fileno($wh) . "\n"; $fh->flush(); waitpid($pid, 0); print $fh "$?\n"; close($fh); } exit(0); }; warn "Unknown problem daemonizing: $@"; exit(1); } sub launch_via_fork { my $class = shift; my ($runner, $job) = @_; my $stage = $class->get_stage($runner); $stage->do_pre_fork($job) if $stage; my $pid = fork(); die "Failed to fork: $!" unless defined $pid; # In parent return $pid if $pid; # In Child my $ok = eval { $0 = 'yath-pending-test'; setpgrp(0, 0) if Test2::Harness::IPC::USE_P_GROUPS(); $runner->stop(); $stage->do_post_fork($job) if $stage; longjump "Test-Runner" => ('run_test', $job, $stage); 1; }; my $err = $@; eval { warn $err } unless $ok; exit(1); } sub cleanup_process { my $class = shift; my ($job, $stage) = @_; $class->update_io($job); # Get the correct filehandles in place early $class->set_env($job); # Set up the necessary env vars $class->build_init_state($job); # Lots of 'misc' stuff. $class->do_loads($job); # Modules that we wanted loaded/imported post fork $class->test2_state($job); # Normalize the Test2 state $stage->do_pre_launch($job) if $stage; $class->final_state($job); # Important final cleanup } sub test2_state { my $class = shift; my ($job) = @_; if ($INC{'Test2/API.pm'}) { Test2::API::test2_stop_preload(); Test2::API::test2_post_preload_reset(); } if ($job->use_stream) { $ENV{T2_FORMATTER} = 'Stream'; require Test2::Formatter::Stream; Test2::Formatter::Stream->import(dir => $job->event_dir, job_id => $job->job_id); } if ($job->event_uuids) { require Test2::Plugin::UUID; Test2::Plugin::UUID->import(); } if ($job->mem_usage) { require Test2::Plugin::MemUsage; Test2::Plugin::MemUsage->import(); } if ($job->io_events) { require Test2::Plugin::IOEvents; Test2::Plugin::IOEvents->import(); } return; } sub final_state { my $class = shift; my ($job) = @_; @ARGV = $job->args; # toggle -w switch late $^W = 1 if $job->use_w_switch; # reset the state of empty pattern matches, so that they have the same # behavior as running in a clean process. # see "The empty pattern //" in perlop. # note that this has to be dynamically scoped and can't go to other subs "" =~ /^/; return; } sub do_loads { my $class = shift; my ($job) = @_; local $@; my $importer = eval <<' EOT' or die $@; package main; #line 0 "-" sub { $_[0]->import(@{$_[1]}) } EOT for my $set ($job->load_import) { my ($mod, $args) = @$set; my $file = mod2file($mod); local $0 = '-'; require $file; $importer->($mod, $args); } for my $mod ($job->load) { my $file = mod2file($mod); local $0 = '-'; require $file; } return; } sub build_init_state { my $class = shift; my ($job) = @_; $0 = $job->rel_file; $class->_reset_DATA(); @ARGV = (); srand(); # avoid child processes sharing the same seed value as the parent @INC = process_includes( list => [$job->includes], include_dot => $job->unsafe_inc, include_current => 1, clean => 1, ); # if FindBin is preloaded, reset it with the new $0 FindBin::init() if defined &FindBin::init; # restore defaults Getopt::Long::ConfigDefaults() if defined &Getopt::Long::ConfigDefaults; return; } sub set_env { my $class = shift; my ($job) = @_; my $env = $job->env_vars; { no warnings 'uninitialized'; $ENV{$_} = $env->{$_} for keys %$env; } $ENV{T2_HARNESS_FORKED} = 1; $ENV{T2_HARNESS_PRELOAD} = 1; return; } sub update_io { my $class = shift; my ($job) = @_; my $out_fh = open_file($job->out_file, '>'); my $err_fh = open_file($job->err_file, '>'); my $in_file = $job->in_file; my $in_fh; $in_fh = open_file($in_file, '<') if $in_file; $out_fh->autoflush(1); $err_fh->autoflush(1); # Keep a copy of the old STDERR for a while so we can still report errors my $stderr = clone_io(\*STDERR); my $die = sub { my @caller = caller; my @caller2 = caller(1); my $msg = "$_[0] at $caller[1] line $caller[2] ($caller2[1] line $caller2[2]).\n"; print $stderr $msg; print STDERR $msg; POSIX::_exit(127); }; swap_io(\*STDIN, $in_fh, $die, '<&') if $in_file; swap_io(\*STDOUT, $out_fh, $die, '>&'); swap_io(\*STDERR, $err_fh, $die, '>&'); $FIX_STDIN = 1 if $in_file; return; } # Heavily modified from forkprove sub _reset_DATA { my $class = shift; for my $set (@{$class->preload_list}) { my ($mod, $file, $pos) = @$set; my $fh = do { no strict 'refs'; *{$mod . '::DATA'}; }; # note that we need to ensure that each forked copy is using a # different file handle, or else concurrent processes will interfere # with each other close $fh if openhandle($fh); if (open $fh, '<', $file) { seek($fh, $pos, 0); } else { warn "Couldn't reopen DATA for $mod ($file): $!"; } } } # Heavily modified from forkprove sub preload_list { my $class = shift; my $list = []; for my $loaded (keys %INC) { next unless $loaded =~ /\.pm$/; my $mod = $loaded; $mod =~ s{/}{::}g; $mod =~ s{\.pm$}{}; my $fh = do { no strict 'refs'; no warnings 'once'; *{$mod . '::DATA'}; }; next unless openhandle($fh); push @$list => [$mod, $INC{$loaded}, tell($fh)]; } return $list; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::runner - For internal use only =head1 DESCRIPTION No Description =head1 USAGE $ yath [YATH OPTIONS] runner [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/failed.pm0000644000175000017500000003740615012417054021636 0ustar exodistexodistpackage App::Yath::Command::failed; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Util::Table qw/table/; use Test2::Harness::Util::File::JSONL; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw{ ( prefix => 'display', category => 'Display Options', description => 'Show only the files that failed, newline separated, no other output. If a file failed once but passed on a retry it will NOT be shown.', ); sub summary { "Show the failed tests from an event log" } sub group { 'log' } sub cli_args { "[--] event_log.jsonl[.gz|.bz2] [job1, job2, ...]" } sub description { return <<" EOT"; This yath command will list the test scripts from an event log that have failed. The only required argument is the path to the log file, which may be compressed. Any extra arguments are assumed to be job id's. If you list any jobs, only the listed jobs will be processed. This command accepts all the same renderer/formatter options that the 'test' command accepts. EOT } sub run { my $self = shift; my $settings = $self->settings; my $args = $self->args; shift @$args if @$args && $args->[0] eq '--'; $self->{+LOG_FILE} = shift @$args or die "You must specify a log file"; die "'$self->{+LOG_FILE}' is not a valid log file" unless -f $self->{+LOG_FILE}; die "'$self->{+LOG_FILE}' does not look like a log file" unless $self->{+LOG_FILE} =~ m/\.jsonl(\.(gz|bz2))?$/; my $stream = Test2::Harness::Util::File::JSONL->new(name => $self->{+LOG_FILE}); my %failed; while(1) { my @events = $stream->poll(max => 1000) or last; for my $event (@events) { my $stamp = $event->{stamp} or next; my $job_id = $event->{job_id} or next; my $f = $event->{facet_data} or next; push @{$failed{$job_id}->{subtests}} => $self->subtests($f) if $f->{parent} && !$f->{trace}->{nested} && $self->include_subtest($f); next unless $f->{harness_job_end}; next unless $f->{harness_job_end}->{fail} || $failed{$job_id}; push @{$failed{$job_id}->{ends}} => $f->{harness_job_end}; } } my $rows = []; while (my ($job_id, $data) = each %failed) { my $ends = $data->{ends} // []; my %seen; my $subtests = join "\n" => grep { !$seen{$_}++ } sort @{$data->{subtests} // []}; if ($settings->display->brief) { print $ends->[-1]->{rel_file}, "\n" if $ends->[-1]->{fail}; } else { push @$rows => [$job_id, scalar(@$ends), $ends->[-1]->{rel_file}, $subtests, $ends->[-1]->{fail} ? "NO" : "YES"]; } } return 0 if $settings->display->brief; unless (@$rows) { print "\nNo jobs failed!\n"; return 0; } print "\nThe following jobs failed at least once:\n"; print join "\n" => table( collapse => 1, header => ['Job ID', 'Times Run', 'Test File', "Subtests", "Succeeded Eventually?"], rows => $rows, ); print "\n"; return 0; } sub include_subtest { my $self = shift; my ($f) = @_; return 0 unless $f->{parent} && keys %{$f->{parent}}; return 0 if $f->{assert}->{pass} || !keys %{$f->{assert}}; return 0 if $f->{amnesty} && @{$f->{amnesty}}; return 1; } sub subtests { my $self = shift; my ($f, $prefix) = @_; return unless $self->include_subtest($f); my $name = $f->{assert}->{details}; unless ($name) { my $frame = $f->{trace}->{frame}; $name = "Unnamed Subtest"; $name .= " ($frame->[1] line $frame->[2])" if $frame->[1] && $frame->[2]; } $name = "$prefix -> $name" if $prefix; my @out; push @out => $name; for my $child (@{$f->{parent}->{children}}) { next unless $child->{parent}; push @out => $self->subtests($child, $name); } return @out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::failed - Show the failed tests from an event log =head1 DESCRIPTION This yath command will list the test scripts from an event log that have failed. The only required argument is the path to the log file, which may be compressed. Any extra arguments are assumed to be job id's. If you list any jobs, only the listed jobs will be processed. This command accepts all the same renderer/formatter options that the 'test' command accepts. =head1 USAGE $ yath [YATH OPTIONS] failed [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --brief =item --no-brief Show only the files that failed, newline separated, no other output. If a file failed once but passed on a retry it will NOT be shown. =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/reload.pm0000644000175000017500000003111515012417054021647 0ustar exodistexodistpackage App::Yath::Command::reload; use strict; use warnings; our $VERSION = '1.000158'; use File::Spec(); use Test2::Harness::Util::File::JSON; use App::Yath::Util qw/find_pfile/; use Test2::Harness::Util qw/open_file/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Reload the persistent test runner" } sub cli_args { "" } sub description { return <<" EOT"; This will send a SIGHUP to the persistent runner, forcing it to reload. This will also clear the blacklist allowing all preloads to load as normal. EOT } sub run { my $self = shift; my $pfile = find_pfile($self->settings, no_fatal => 1) or die "Could not find a persistent yath running.\n"; my $data = Test2::Harness::Util::File::JSON->new(name => $pfile)->read(); my $blacklist = File::Spec->catfile($data->{dir}, 'BLACKLIST'); if (-e $blacklist) { print "Deleting module blacklist...\n"; unlink($blacklist) or warn "Could not delete blacklist file!"; } print "\nSending SIGHUP to $data->{pid}\n\n"; kill('HUP', $data->{pid}) or die "Could not send signal!\n"; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::reload - Reload the persistent test runner =head1 DESCRIPTION This will send a SIGHUP to the persistent runner, forcing it to reload. This will also clear the blacklist allowing all preloads to load as normal. =head1 USAGE $ yath [YATH OPTIONS] reload [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/replay.pm0000644000175000017500000004235115012417054021701 0ustar exodistexodistpackage App::Yath::Command::replay; use strict; use warnings; our $VERSION = '1.000158'; use App::Yath::Options; require App::Yath::Command::test; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw/+renderers SUPER::init() if $self->can('SUPER::init'); $self->{+TESTS_SEEN} //= 0; $self->{+ASSERTS_SEEN} //= 0; } sub run { my $self = shift; my $args = $self->args; my $settings = $self->settings; my $renderers = $self->App::Yath::Command::test::renderers; shift @$args if @$args && $args->[0] eq '--'; $self->{+LOG_FILE} = shift @$args or die "You must specify a log file"; die "'$self->{+LOG_FILE}' is not a valid log file" unless -f $self->{+LOG_FILE}; die "'$self->{+LOG_FILE}' does not look like a log file" unless $self->{+LOG_FILE} =~ m/\.jsonl(\.(gz|bz2))?$/; my $jobs = @$args ? {map {$_ => 1} @$args} : undef; my $stream = Test2::Harness::Util::File::JSONL->new(name => $self->{+LOG_FILE}); while (1) { my @events = $stream->poll(max => 1000) or last; for my $e (@events) { last unless defined $e; $self->{+TESTS_SEEN}++ if $e->{facet_data}->{harness_job_launch}; $self->{+ASSERTS_SEEN}++ if $e->{facet_data}->{assert}; if ($jobs) { my $f = $e->{facet_data}->{harness_job_start} // $e->{facet_data}->{harness_job_queued}; if ($f && !$jobs->{$e->{job_id}}) { for my $field (qw/rel_file abs_file file/) { my $file = $f->{$field} or next; next unless $jobs->{$file}; $jobs->{$e->{job_id}} = 1; last; } } } if (my $final = $e->{facet_data}->{harness_final}) { $self->{+FINAL_DATA} = $final; } else { next if $jobs && !$jobs->{$e->{job_id}}; $_->render_event($e) for @$renderers; } } } $_->finish() for @$renderers; my $final_data = $self->{+FINAL_DATA} or die "Log did not contain final data!\n"; $self->App::Yath::Command::test::render_final_data($final_data); $self->App::Yath::Command::test::render_summary($final_data->{pass}); return $final_data->{pass} ? 0 : 1; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::replay - Replay a test run from an event log =head1 DESCRIPTION This yath command will re-run the harness against an event log produced by a previous test run. The only required argument is the path to the log file, which maybe compressed. Any extra arguments are assumed to be job id's. If you list any jobs, only listed jobs will be processed. This command accepts all the same renderer/formatter options that the 'test' command accepts. =head1 USAGE $ yath [YATH OPTIONS] replay [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/status.pm0000644000175000017500000010263115012417054021726 0ustar exodistexodistpackage App::Yath::Command::status; use strict; use warnings; our $VERSION = '1.000158'; use Term::Table(); use File::Spec(); use Test2::Harness::Runner::State; use Test2::Harness::Util::File::JSON(); use Test2::Harness::Util::Queue(); use parent 'App::Yath::Command::run'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Status info and process lists for the runner" } sub cli_args { "" } sub description { return <<" EOT"; This command will provide health details and a process list for the runner. EOT } sub pfile_params { (no_fatal => 1) } sub run { my $self = shift; my $data = $self->pfile_data(); my $state = Test2::Harness::Runner::State->new( workdir => $self->workdir, observe => 1, ); $state->poll; print "\n**** Pending tests: ****\n"; my $pending = $state->pending_tasks; for my $run ($state->run, @{$state->pending_runs // []}) { next unless $run; my $run_id =$run->{run_id} or next; print "\nRun $run_id:\n"; my $pending = $pending->{$run_id} // {}; my @tasks; my @check = ($pending); while (my $it = shift @check) { my $ref = ref($it); if ($ref eq 'ARRAY') { push @check => @$it; next; } if ($ref eq 'HASH') { if ($it->{job_id}) { push @tasks => $it; next; } push @check => values %$it; next; } } if (!@tasks) { print "--No pending tasks for this run--\n"; next; } my @rows = map {[$_->{job_id}, $_->{is_try} // $_->{job_try} // 0, $_->{rel_file}, join(', ' => @{$_->{conflicts} // []})]} @tasks; my $run_table = Term::Table->new( collapse => 1, header => [qw/uuid try test conflicts/], rows => [ sort { $a->[2] cmp $b->[2] } @rows ], ); print "$_\n" for $run_table->render; } print "\n**** Runner Stages: ****\n"; my $stage_status = $state->stage_readiness // {}; my $reload_status = $state->reload_state // {}; my $reload_issues = 0; my $rows = []; for my $stage (keys %$stage_status) { my $pid = $stage_status->{$stage} ||= ''; my $ready = $pid ? 'YES' : 'NO'; $pid = 'N/A' if $pid && $pid == 1; my $issues = keys %{$reload_status->{$stage}}; my $reload = $issues ? 'YES' : 'NO'; $reload_issues += $issues; push @$rows => [$pid, $stage, $ready, $reload]; } @$rows = sort { $a->[0] <=> $b->[0] } @$rows; my $stage_table = Term::Table->new( collapse => 1, header => [qw/pid stage ready/, 'reload issues'], rows => $rows, ); print "$_\n" for $stage_table->render; if ($reload_issues) { my %seen; print "\n**** Reload issues: ****\n"; for my $stage (sort keys %$reload_status) { for my $file (keys %{$reload_status->{$stage}}) { next if $seen{$file}++; my $data = $reload_status->{$stage}->{$file} or next; print "\n==== SOURCE FILE: $file ====\n"; print $data->{error} if $data->{error}; print $_ for @{$data->{warnings} // []}; } } print "\n"; } print "\n**** Running tests: ****\n"; my $running = $state->running_tasks; my $running_tasks = [values %$running]; my @rows = map {[$self->get_job_pid($_->{run_id}, $_->{job_id}) // 'N/A', $_->{job_id}, $_->{is_try} // $_->{job_try} // 0, $_->{rel_file}, join(', ' => @{$_->{conflicts} // []})]} @$running_tasks; if (@rows) { my $run_table = Term::Table->new( collapse => 1, header => [qw/pid uuid try test conflicts/], rows => [ sort { $a->[0] <=> $b->[0] } @rows ], ); print "$_\n" for $run_table->render; } return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::status - Status info and process lists for the runner =head1 DESCRIPTION This command will provide health details and a process list for the runner. =head1 USAGE $ yath [YATH OPTIONS] status [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used ot set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C, C =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head3 NO CATEGORY - FIX ME =over 4 =item --check-reload-state =item --no-check-reload-state Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/which.pm0000644000175000017500000003031115012417054021500 0ustar exodistexodistpackage App::Yath::Command::which; use strict; use warnings; our $VERSION = '1.000158'; use App::Yath::Util qw/find_pfile/; use Test2::Harness::Util::File::JSON; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Locate the persistent test runner" } sub cli_args { "" } sub description { return <<" EOT"; This will tell you about any persistent runners it can find. EOT } sub run { my $self = shift; my $pfile = find_pfile($self->settings, no_fatal => 1); unless ($pfile) { print "\nNo persistent harness was found for the current path.\n\n"; return 0; } print "\nFound: $pfile\n"; my $data = Test2::Harness::Util::File::JSON->new(name => $pfile)->read(); print " PID: $data->{pid}\n"; print " Dir: $data->{dir}\n"; print "\n"; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::which - Locate the persistent test runner =head1 DESCRIPTION This will tell you about any persistent runners it can find. =head1 USAGE $ yath [YATH OPTIONS] which [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/times.pm0000644000175000017500000003615015012417054021526 0ustar exodistexodistpackage App::Yath::Command::times; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Util::Times qw/render_duration/; use Test2::Harness::Util::File::JSONL; use App::Yath::Options; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw/-log_file 1 } @NUMERIC; my @ALPHA = qw/file/; my %ALPHA = map { $_ => 1 } @ALPHA; my @FIELDS = (@NUMERIC, @ALPHA); my %FIELDS = map { $_ => 1 } @FIELDS; sub run { my $self = shift; my $args = $self->args; shift @$args if @$args && $args->[0] eq '--'; $self->{+LOG_FILE} = shift @$args or die "You must specify a log file"; die "'$self->{+LOG_FILE}' is not a valid log file" unless -f $self->{+LOG_FILE}; die "'$self->{+LOG_FILE}' does not look like a log file" unless $self->{+LOG_FILE} =~ m/\.jsonl(\.(gz|bz2))?$/; my %seen; my @fields; for my $field (@$args, @FIELDS) { $field = lc($field); next if $seen{$field}++; die "'$field' is not a valid field\n" unless $FIELDS{$field}; push @fields => $field; } $self->{+FIELDS} = \@fields; my $stream = Test2::Harness::Util::File::JSONL->new(name => $self->{+LOG_FILE}); my @jobs; while (1) { my @events = $stream->poll(max => 1000) or last; for my $event (@events) { my $stamp = $event->{stamp} or next; my $job_id = $event->{job_id} or next; my $f = $event->{facet_data} or next; next unless $f->{harness_job_end}; my $job = {}; $job->{file} = $f->{harness_job_end}->{rel_file} if $f->{harness_job_end} && $f->{harness_job_end}->{rel_file}; $job->{time} = $f->{harness_job_end}->{times}->{totals} if $f->{harness_job_end} && $f->{harness_job_end}->{times}; push @jobs => $job; } } my @rows; my $totals = {file => 'TOTAL'}; @jobs = sort { $self->sort_compare($a, $b) } @jobs; for my $job (@jobs) { my $data = $job->{time}; push @rows => $self->build_row({%$data, file => $job->{file}}); $totals->{$_} += $data->{$_} for @NUMERIC; } push @rows => [map { '--' } @fields]; push @rows => $self->build_row($totals); require Term::Table; my $table = Term::Table->new( header => [map { ucfirst($_) } @fields], rows => \@rows, ); print "$_\n" for $table->render; return 0; } sub build_row { my $self = shift; my ($data) = @_; return [map { $NUMERIC{$_} && defined($data->{$_}) ? render_duration($data->{$_}) : $data->{$_} } @{$self->{+FIELDS}}]; } sub sort_compare { my $self = shift; my ($ja, $jb) = @_; my $order = $self->{+FIELDS}; my $ta = $ja->{time}; my $tb = $jb->{time}; for my $field (@$order) { my $fa = $ta->{$field}; my $fb = $tb->{$field}; my $da = defined $fa; my $db = defined $fb; next unless $da || $db; return 1 if $da && !$db; return -1 if $db && !$da; my $delta = $ALPHA{$field} ? lc($fa) cmp lc($fb) : $fa <=> $fb; return $delta if $delta; } return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::times - Get times from a test log =head1 DESCRIPTION This command will consume the log of a previous run, and output all timing data from shortest test to longest. You can specify a sort order by listing fields in your desired order after the log file on the command line. =head1 USAGE $ yath [YATH OPTIONS] times [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/watch.pm0000644000175000017500000003345515012417054021520 0ustar exodistexodistpackage App::Yath::Command::watch; use strict; use warnings; our $VERSION = '1.000158'; use Time::HiRes qw/sleep/; use Test2::Harness::Util::File::JSON; use App::Yath::Util qw/find_pfile/; use Test2::Harness::Util qw/open_file/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Monitor the persistent test runner" } sub cli_args { "" } sub description { return <<" EOT"; This command will tail the logs from a persistent instance of yath. STDOUT and STDERR will be printed as seen, so may not be in proper order. EOT } sub run { my $self = shift; my $args = $self->args; shift @$args if @$args && $args->[0] eq '--'; my $stop; $stop = 1 if @$args && $args->[0] eq 'STOP'; my $pfile = find_pfile($self->settings, no_fatal => 1) or die "No persistent harness was found for the current path.\n"; print "\nFound: $pfile\n"; my $data = Test2::Harness::Util::File::JSON->new(name => $pfile)->read(); print " PID: $data->{pid}\n"; print " Dir: $data->{dir}\n"; print "\n"; my $err_f = File::Spec->catfile($data->{dir}, 'error.log'); my $out_f = File::Spec->catfile($data->{dir}, 'output.log'); my $err_fh = open_file($err_f, '<'); my $out_fh = open_file($out_f, '<'); my $auxdir = File::Spec->catdir($data->{dir}, 'aux_logs'); my %aux; while (1) { my $count = 0; while (my $line = <$out_fh>) { $count++; print STDOUT $line; } while (my $line = <$err_fh>) { $count++; print STDERR $line; } if (-d $auxdir) { opendir(my $dh, $auxdir) or die "Could not open auxdir: $!"; for my $file (readdir($dh)) { next if $aux{$file}; next unless $file =~ m/\.log$/; my $full = File::Spec->catfile($auxdir, $file); next unless -f $full; $aux{$file} = open_file($full, '<'); $count++; } } for my $file (sort keys %aux) { my $fh = $aux{$file}; my $ofh = $file =~ m/STDERR/ ? \*STDERR : \*STDOUT; while (my $line = <$fh>) { print $ofh $line; } } next if $count; last if $stop; last unless -f $pfile; sleep 0.02; } return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::watch - Monitor the persistent test runner =head1 DESCRIPTION This command will tail the logs from a persistent instance of yath. STDOUT and STDERR will be printed as seen, so may not be in proper order. =head1 USAGE $ yath [YATH OPTIONS] watch [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/abort.pm0000644000175000017500000007553015012417054021521 0ustar exodistexodistpackage App::Yath::Command::abort; use strict; use warnings; our $VERSION = '1.000158'; use Time::HiRes qw/sleep/; use Term::Table; use File::Spec(); use App::Yath::Util qw/find_pfile/; use Test2::Harness::Runner::State; use Test2::Harness::Util::File::JSON(); use Test2::Harness::Util::Queue(); use Test2::Harness::Util qw/open_file/; use parent 'App::Yath::Command::status'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Abort all currently running or queued tests without killing the runner" } sub cli_args { "" } sub description { return <<" EOT"; This command will kill all running tests and clear the queue, but will not close the runner. EOT } sub pfile_params { (no_fatal => 1) } sub run { my $self = shift; # Get the output from finding the pfile $self->pfile_data(); my $state = Test2::Harness::Runner::State->new( workdir => $self->workdir, observe => 1, ); $state->poll; print "\nTruncating Queue...\n\n"; $state->truncate; $state->poll; my $running = $state->running_tasks; for my $task (values %$running) { my $pid = $self->get_job_pid($task->{run_id}, $task->{job_id}) // next;; my $file = $task->{rel_file}; print "Killing test $pid - $file...\n"; kill('INT', $pid); } print "\n"; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::abort - Abort all currently running or queued tests without killing the runner =head1 DESCRIPTION This command will kill all running tests and clear the queue, but will not close the runner. =head1 USAGE $ yath [YATH OPTIONS] abort [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used ot set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C, C =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head3 NO CATEGORY - FIX ME =over 4 =item --check-reload-state =item --no-check-reload-state Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/start.pm0000644000175000017500000005762115012417054021550 0ustar exodistexodistpackage App::Yath::Command::start; use strict; use warnings; our $VERSION = '1.000158'; use App::Yath::Util qw/find_pfile/; use App::Yath::Options; use Test2::Harness::Run; use Test2::Harness::Util::Queue; use Test2::Harness::Util::File::JSON; use Test2::Harness::IPC; use Test2::Harness::Util::JSON qw/encode_json decode_json/; use Test2::Harness::Util qw/mod2file open_file parse_exit clean_path/; use Test2::Util::Table qw/table/; use Test2::Harness::Util::IPC qw/run_cmd USE_P_GROUPS/; use POSIX; use File::Spec; use Sys::Hostname qw/hostname/; use Time::HiRes qw/sleep/; use Carp qw/croak/; use File::Path qw/remove_tree/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; include_options( 'App::Yath::Options::Debug', 'App::Yath::Options::PreCommand', 'App::Yath::Options::Runner', 'App::Yath::Options::Workspace', 'App::Yath::Options::Persist', 'App::Yath::Options::Collector', ); option_group {prefix => 'runner', category => "Persistent Runner Options"} => sub { option reload => ( short => 'r', type => 'b', description => "Attempt to reload modified modules in-place, restarting entire stages only when necessary.", default => 0, ); option restrict_reload => ( type => 'D', long_examples => ['', '=path'], short_examples => ['', '=path'], description => "Only reload modules under the specified path, if no path is specified look at anything under the .yath.rc path, or the current working directory.", normalize => sub { $_[0] eq '1' ? $_[0] : clean_path($_[0]) }, action => \&restrict_action, ); option quiet => ( short => 'q', type => 'c', description => "Be very quiet.", default => 0, ); }; sub restrict_action { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; if ($norm eq '1') { my $hset = $settings->harness; my $path = $hset->config_file || $hset->cwd; $path //= do { require Cwd; Cwd::getcwd() }; $path =~ s{\.yath\.rc$}{}g; push @{$$slot} => $path; } else { push @{$$slot} => $norm; } } sub MAX_ATTACH() { 1_048_576 } sub group { 'persist' } sub always_keep_dir { 1 } sub summary { "Start the persistent test runner" } sub cli_args { "" } sub description { return <<" EOT"; This command is used to start a persistant instance of yath. A persistant instance is useful because it allows you to preload modules in advance, reducing start time for any tests you decide to run as you work. A running instance will watch for changes to any preloaded files, and restart itself if anything changes. Changed files are blacklisted for subsequent reloads so that reloading is not a frequent occurence when editing the same file over and over again. EOT } sub run { my $self = shift; $ENV{TEST2_HARNESS_NO_WRITE_TEST_INFO} //= 1; my $settings = $self->settings; my $dir = $settings->workspace->workdir; my $pfile = find_pfile($settings, vivify => 1, no_checks => 1); if (-f $pfile) { remove_tree($dir, {safe => 1, keep_root => 0}); die "Persistent harness appears to be running, found $pfile\n"; } $self->write_settings_to($dir, 'settings.json'); my $run_queue = Test2::Harness::Util::Queue->new(file => File::Spec->catfile($dir, 'run_queue.jsonl')); $run_queue->start(); $self->setup_plugins(); $self->setup_resources(); my $stderr = File::Spec->catfile($dir, 'error.log'); my $stdout = File::Spec->catfile($dir, 'output.log'); my @prof; if ($settings->runner->nytprof) { push @prof => '-d:NYTProf'; } my $pid = run_cmd( stderr => $stderr, stdout => $stdout, no_set_pgrp => !$settings->runner->daemon, command => [ $^X, @prof, $settings->harness->script, (map { "-D$_" } @{$settings->harness->dev_libs}), '--no-scan-plugins', # Do not preload any plugin modules runner => $dir, monitor_preloads => 1, persist => $pfile, jobs_todo => 0, ], ); unless ($settings->runner->quiet) { print "\nPersistent runner started!\n"; print "Runner PID: $pid\n"; print "Runner dir: $dir\n"; print "\nUse `yath watch` to monitor the persistent runner\n\n" if $settings->runner->daemon; } Test2::Harness::Util::File::JSON->new(name => $pfile)->write({ pid => $pid, dir => $dir, version => $VERSION, user => $ENV{USER}, hostname => hostname(), }); return 0 if $settings->runner->daemon; $SIG{TERM} = sub { kill(TERM => $pid) }; $SIG{INT} = sub { kill(INT => $pid) }; my $err_fh = open_file($stderr, '<'); my $out_fh = open_file($stdout, '<'); while (1) { my $out = waitpid($pid, WNOHANG); my $wstat = $?; my $count = 0; while (my $line = <$out_fh>) { $count++; print STDOUT $line; } while (my $line = <$err_fh>) { $count++; print STDERR $line; } sleep(0.02) unless $out || $count; next if $out == 0; return 255 if $out < 0; my $exit = parse_exit($?); return $exit->{err} || $exit->{sig} || 0; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::start - Start the persistent test runner =head1 DESCRIPTION This command is used to start a persistant instance of yath. A persistant instance is useful because it allows you to preload modules in advance, reducing start time for any tests you decide to run as you work. A running instance will watch for changes to any preloaded files, and restart itself if anything changes. Changed files are blacklisted for subsequent reloads so that reloading is not a frequent occurence when editing the same file over and over again. =head1 USAGE $ yath [YATH OPTIONS] start [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Collector Options =over 4 =item --max-open-jobs 18 =item --no-max-open-jobs Maximum number of jobs a collector can process at a time, if more jobs are pending their output will be delayed until the earlier jobs have been processed. (Default: double the -j value) =item --max-poll-events 1000 =item --no-max-poll-events Maximum number of events to poll from a job before jumping to the next job. (Default: 1000) =back =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 Persistent Runner Options =over 4 =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --reload =item -r =item --no-reload Attempt to reload modified modules in-place, restarting entire stages only when necessary. =item --restrict-reload =item --restrict-reload=path =item --no-restrict-reload Only reload modules under the specified path, if no path is specified look at anything under the .yath.rc path, or the current working directory. Can be specified multiple times =back =head3 Runner Options =over 4 =item --abort-on-bail =item --no-abort-on-bail Abort all testing if a bail-out is encountered (default: on) =item --blib =item -b =item --no-blib (Default: include if it exists) Include 'blib/lib' and 'blib/arch' in your module path =item --cover =item --cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --no-cover Use Devel::Cover to calculate test coverage. This disables forking. If no args are specified the following are used: -silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --daemon =item --no-daemon Start the runner as a daemon (Default: True) =item --dump-depmap =item --no-dump-depmap When using staged preload, dump the depmap for each stage as json files =item --event-timeout SECONDS =item --et SECONDS =item --no-event-timeout Kill test if no output is received within timeout period. (Default: 60 seconds). Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. This prevents a hung test from running forever. =item --include ARG =item --include=ARG =item -I ARG =item -I=ARG =item --no-include Add a directory to your include paths Can be specified multiple times =item --job-count 4 =item --job-count 8:2 =item --jobs 4 =item --jobs 8:2 =item -j4 =item -j8:2 =item --no-job-count Set the number of concurrent jobs to run. Add a :# if you also wish to designate multiple slots per test. 8:2 means 8 slots, but each test gets 2 slots, so 4 tests run concurrently. Tests can find their concurrency assignemnt in the "T2_HARNESS_MY_JOB_CONCURRENCY" environment variable. Can also be set with the following environment variables: C, C, C =item --lib =item -l =item --no-lib (Default: include if it exists) Include 'lib' in your module path =item --nytprof =item --no-nytprof Use Devel::NYTProf on tests. This will set addpid=1 for you. This works with or without fork. =item --post-exit-timeout SECONDS =item --pet SECONDS =item --no-post-exit-timeout Stop waiting post-exit after the timeout period. (Default: 15 seconds) Some tests fork and allow the parent to exit before writing all their output. If Test2::Harness detects an incomplete plan after the test exits it will monitor for more events until the timeout period. Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. =item --preload-threshold ARG =item --preload-threshold=ARG =item --Pt ARG =item --Pt=ARG =item -W ARG =item -W=ARG =item --no-preload-threshold Only do preload if at least N tests are going to be run. In some cases a full preload takes longer than simply running the tests, this lets you specify a minimum number of test jobs that will be run for preload to happen. This has no effect for a persistent runner. The default is 0, and it means always preload. =item --preloads ARG =item --preloads=ARG =item --preload ARG =item --preload=ARG =item -P ARG =item -P=ARG =item --no-preloads Preload a module before running tests Can be specified multiple times =item --resource Port =item --resource +Test2::Harness::Runner::Resource::Port =item -R Port =item --no-resource Use a resource module to assign resource assignments to individual tests Can be specified multiple times =item --runner-id ARG =item --runner-id=ARG =item --no-runner-id Runner ID (usually a generated uuid) =item --shared-jobs-config .sharedjobslots.yml =item --shared-jobs-config relative/path/.sharedjobslots.yml =item --shared-jobs-config /absolute/path/.sharedjobslots.yml =item --no-shared-jobs-config Where to look for a shared slot config file. If a filename with no path is provided yath will search the current and all parent directories for the name. =item --slots-per-job 2 =item -x2 =item --no-slots-per-job This sets the number of slots each job will use (default 1). This is normally set by the ':#' in '-j#:#'. Can also be set with the following environment variables: C =item --switch ARG =item --switch=ARG =item -S ARG =item -S=ARG =item --no-switch Pass the specified switch to perl for each test. This is not compatible with preload. Can be specified multiple times =item --tlib =item --no-tlib (Default: off) Include 't/lib' in your module path =item --unsafe-inc =item --no-unsafe-inc perl is removing '.' from @INC as a security concern. This option keeps things from breaking for now. Can also be set with the following environment variables: C =item --use-fork =item --fork =item --no-use-fork (default: on, except on windows) Normally tests are run by forking, which allows for features like preloading. This will turn off the behavior globally (which is not compatible with preloading). This is slower, it is better to tag misbehaving tests with the '# HARNESS-NO-PRELOAD' comment in their header to disable forking only for those tests. Can also be set with the following environment variables: C, C, C, C, C =item --use-timeout =item --timeout =item --no-use-timeout (default: on) Enable/disable timeouts =back =head3 Workspace Options =over 4 =item --clear =item -C =item --no-clear Clear the work directory if it is not already empty =item --tmp-dir ARG =item --tmp-dir=ARG =item --tmpdir ARG =item --tmpdir=ARG =item -t ARG =item -t=ARG =item --no-tmp-dir Use a specific temp directory (Default: use system temp dir) Can also be set with the following environment variables: C, C, C, C, C, C =item --workdir ARG =item --workdir=ARG =item -w ARG =item -w=ARG =item --no-workdir Set the work directory (Default: new temp directory) Can also be set with the following environment variables: C, C =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/spawn.pm0000644000175000017500000004136315012417054021537 0ustar exodistexodistpackage App::Yath::Command::spawn; use strict; use warnings; our $VERSION = '1.000158'; use App::Yath::Options; use Time::HiRes qw/sleep time/; use File::Temp qw/tempfile/; use Test2::Harness::Util qw/parse_exit/; use parent 'App::Yath::Command::run'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Launch a perl script from the preloaded environment" } sub cli_args { "[--] path/to/script.pl [options and args]" } sub description { return <<" EOT"; This will launch the specified script from the preloaded yath process. NOTE: environment variables are not automatically passed to the spawned process. You must use -e or -E (see help) to specify what environment variables you care about. EOT } option_group {prefix => 'spawn', category => 'spawn options'} => sub { option stage => ( short => 's', type => 's', description => 'Specify the stage to be used for launching the script', long_examples => [ ' foo'], short_examples => [ ' foo'], default => 'default', ); option copy_env => ( short => 'e', type => 'm', description => "Specify environment variables to pass along with their current values, can also use a regex", long_examples => [ ' HOME', ' SHELL', ' /PERL_.*/i' ], short_examples => [ ' HOME', ' SHELL', ' /PERL_.*/i' ], ); option env_var => ( field => 'env_vars', short => 'E', type => 'h', long_examples => [' VAR=VAL'], short_examples => ['VAR=VAL', ' VAR=VAL'], description => 'Set environment variables for the spawn', ); }; sub read_line { my ($fh, $timeout) = @_; $timeout //= 300; my $start = time; while (1) { if ($timeout < (time - $start)) { my @caller = caller; die "Timed out at $caller[1] line $caller[2].\n"; } seek($fh, 0,1) if eof($fh); my $out = <$fh> // next; chomp($out); return $out; } } # This is here for subclasses sub queue_spawn { my $self = shift; my ($args) = @_; $self->state->queue_spawn($args); } sub run_script { shift @ARGV // die "No script specified" } sub stage { $_[0]->settings->spawn->stage } sub env_vars { my $self = shift; my $settings = $self->settings; my $env = {}; for my $var (@{$settings->spawn->copy_env}) { if ($var =~ m{^/(.*)/(\w*)$}s) { my ($re, $opts) = ($1, $2); my $pattern = length($opts) ? "(?$opts)$re" : $re; $env->{$_} = $ENV{$_} for grep { m/$pattern/ } keys %ENV; } else { $env->{$var} = $ENV{$var}; } } my $set = $settings->spawn->env_vars; $env->{$_} = $set->{$_} for keys %$set; return $env; } sub set_pname { my $self = shift; my ($run) = @_; $0 = "yath-" . $self->name . " $run " . join (' ', @ARGV); } sub pre_process_argv { shift @ARGV if @ARGV && $ARGV[0] eq '--'; } sub sig_handlers { qw/INT TERM HUP QUIT USR1 USR2 STOP WINCH/ } sub set_sig_handlers { my $self = shift; my ($wpid) = @_; local $@; eval { my $s = $_; $SIG{$s} = sub { kill($s, $wpid) } } for $self->sig_handlers; } sub clear_sig_handlers { my $self = shift; local $@; eval { my $s = $_; $SIG{$s} = 'DEFAULT' } for $self->sig_handlers; } sub pre_exit_hook {} sub run { my $self = shift; $self->pre_process_argv; my $run = $self->run_script; $self->set_pname($run); my ($fh, $name) = tempfile(UNLINK => 1); close($fh); $self->queue_spawn({ stage => $self->stage // 'default', file => $run, owner => $$, ipcfile => $name, args => [@ARGV], env_vars => $self->env_vars, }); open($fh, '<', $name) or die "Could not open ipcfile: $!"; my $mpid = read_line($fh); my $wpid = read_line($fh); my $win = read_line($fh); $self->set_sig_handlers($wpid); open(my $wfh, '>>', "/proc/$mpid/fd/$win") or die "Could not open /proc/$wpid/fd/$win: $!"; $wfh->autoflush(1); STDIN->blocking(0); while (0 < kill(0, $mpid)) { my $line = ; if (defined $line) { print $wfh $line; } else { sleep 0.2; } } $self->clear_sig_handlers(); my $exit = read_line($fh) // die "Could not get exit code"; $exit = parse_exit($exit); if ($exit->{sig}) { print STDERR "Terminated with signal: $exit->{sig}.\n"; kill($exit->{sig}, $$); } print STDERR "Exited with code: $exit->{err}.\n" if $exit->{err}; $self->pre_exit_hook($exit); exit($exit->{err}); } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::spawn - Launch a perl script from the preloaded environment =head1 DESCRIPTION This will launch the specified script from the preloaded yath process. NOTE: environment variables are not automatically passed to the spawned process. You must use -e or -E (see help) to specify what environment variables you care about. =head1 USAGE $ yath [YATH OPTIONS] spawn [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head3 spawn options =over 4 =item --copy-env HOME =item --copy-env SHELL =item --copy-env /PERL_.*/i =item -e HOME =item -e SHELL =item -e /PERL_.*/i =item --no-copy-env Specify environment variables to pass along with their current values, can also use a regex Can be specified multiple times =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables for the spawn Can be specified multiple times =item --stage foo =item -s foo =item --no-stage Specify the stage to be used for launching the script =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/kill.pm0000644000175000017500000007507115012417054021345 0ustar exodistexodistpackage App::Yath::Command::kill; use strict; use warnings; our $VERSION = '1.000158'; use Time::HiRes qw/sleep/; use App::Yath::Util qw/find_pfile/; use File::Path qw/remove_tree/; use Test2::Harness::Util::File::JSON(); use parent 'App::Yath::Command::abort'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Kill the runner and any running or pending tests" } sub cli_args { "" } sub description { return <<" EOT"; This command will kill the active yath runner and any running or pending tests. EOT } sub pfile_params { (no_checks => 1) } sub run { my $self = shift; my $data = $self->pfile_data(); my $pfile = $data->{pfile_path}; $self->App::Yath::Command::test::terminate_queue(); $_->teardown($self->settings) for @{$self->settings->harness->plugins}; $self->SUPER::run(); sleep(0.02) while kill(0, $self->pfile_data->{pid}); unlink($pfile) if -f $pfile; remove_tree($self->workdir, {safe => 1, keep_root => 0}) if -d $self->workdir; print "\n\nRunner stopped\n\n" unless $self->settings->display->quiet; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::kill - Kill the runner and any running or pending tests =head1 DESCRIPTION This command will kill the active yath runner and any running or pending tests. =head1 USAGE $ yath [YATH OPTIONS] kill [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used ot set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C, C =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head3 NO CATEGORY - FIX ME =over 4 =item --check-reload-state =item --no-check-reload-state Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/help.pm0000644000175000017500000003312715012417054021336 0ustar exodistexodistpackage App::Yath::Command::help; use strict; use warnings; use Test2::Util qw/pkg_to_file/; our $VERSION = '1.000158'; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw/<_command_info_hash/; use Test2::Harness::Util qw/open_file find_libraries/; use List::Util (); sub options {}; sub group { '' } sub summary { 'Show the list of commands' } sub description { return <<" EOT" This command provides a list of commands when called with no arguments. When given a command name as an argument it will print the help for that command. EOT } sub command_info_hash { my $self = shift; return $self->{+_COMMAND_INFO_HASH} if $self->{+_COMMAND_INFO_HASH}; my %commands; my $command_libs = find_libraries('App::Yath::Command::*'); for my $lib (sort keys %$command_libs) { my $ok = eval { require $command_libs->{$lib}; 1 }; unless ($ok) { warn "Failed to load command '$command_libs->{$lib}': $@"; next; } next if $lib->internal_only; my $name = $lib->name; my $group = $lib->group; $commands{$group}->{$name} = $lib->summary; } return $self->{+_COMMAND_INFO_HASH} = \%commands; } sub command_list { my $self = shift; my $command_hash = $self->command_info_hash(); my @commands = map keys %$_, values %$command_hash; return @commands; } sub run { my $self = shift; my $args = $self->{+ARGS}; return $self->command_help($args->[0]) if @$args; my $script = $self->settings->harness->script // $0; my $maxlen = List::Util::max(map length, $self->command_list); print "\nUsage: $script COMMAND [options]\n\nAvailable Commands:\n"; my $command_info_hash = $self->command_info_hash; for my $group (sort keys %$command_info_hash) { my $set = $command_info_hash->{$group}; printf(" %${maxlen}s: %s\n", $_, $set->{$_}) for sort keys %$set; print "\n"; } return 0; } sub command_help { my $self = shift; my ($command) = @_; require App::Yath; my $cmd_class = App::Yath->load_command($command); print $cmd_class->cli_help(settings => $self->{+SETTINGS}); return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::help - Show the list of commands =head1 DESCRIPTION This command provides a list of commands when called with no arguments. When given a command name as an argument it will print the help for that command. =head1 USAGE $ yath [YATH OPTIONS] help [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/test.pm0000644000175000017500000017142115012417054021365 0ustar exodistexodistpackage App::Yath::Command::test; use strict; use warnings; our $VERSION = '1.000158'; use App::Yath::Options; use Test2::Harness::Run; use Test2::Harness::Event; use Test2::Harness::Util::Queue; use Test2::Harness::Util::File::JSON; use Test2::Harness::IPC; use Test2::Harness::Runner::State; use Test2::Harness::Util::JSON qw/encode_json decode_json JSON/; use Test2::Harness::Util qw/mod2file open_file chmod_tmp/; use Test2::Util::Table qw/table/; use Test2::Harness::Util::Term qw/USE_ANSI_COLOR/; use File::Spec; use Fcntl(); use Time::HiRes qw/sleep time/; use List::Util qw/sum max min/; use Carp qw/croak/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw/ '-MDevel::Cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl'; } my $plugins = $settings->harness->plugins; if (@$plugins) { push @out => $_->spawn_args($settings) for grep { $_->can('spawn_args') } @$plugins; } return @out; } sub init { my $self = shift; $self->SUPER::init() if $self->can('SUPER::init'); $self->{+TESTS_SEEN} //= 0; $self->{+ASSERTS_SEEN} //= 0; $self->{+CLEANUP_SUBS} = []; } sub _resize_pipe { return unless defined &Fcntl::F_SETPIPE_SZ; my ($fh) = @_; # 1mb if we can my $size = 1024 * 1024 * 1; # On linux systems lets go for the smaller of the two between 1mb and # system max. if (-e '/proc/sys/fs/pipe-max-size') { open(my $max, '<', '/proc/sys/fs/pipe-max-size'); chomp(my $val = <$max>); close($max); $size = min($size, $val); } fcntl($fh, Fcntl::F_SETPIPE_SZ(), $size); } sub auditor_reader { my $self = shift; return $self->{+AUDITOR_READER} if $self->{+AUDITOR_READER}; pipe($self->{+AUDITOR_READER}, $self->{+COLLECTOR_WRITER}) or die "Could not create pipe: $!"; _resize_pipe($self->{+COLLECTOR_WRITER}); return $self->{+AUDITOR_READER}; } sub collector_writer { my $self = shift; return $self->{+COLLECTOR_WRITER} if $self->{+COLLECTOR_WRITER}; pipe($self->{+AUDITOR_READER}, $self->{+COLLECTOR_WRITER}) or die "Could not create pipe: $!"; _resize_pipe($self->{+COLLECTOR_WRITER}); return $self->{+COLLECTOR_WRITER}; } sub renderer_reader { my $self = shift; return $self->{+RENDERER_READER} if $self->{+RENDERER_READER}; pipe($self->{+RENDERER_READER}, $self->{+AUDITOR_WRITER}) or die "Could not create pipe: $!"; _resize_pipe($self->{+AUDITOR_WRITER}); return $self->{+RENDERER_READER}; } sub auditor_writer { my $self = shift; return $self->{+AUDITOR_WRITER} if $self->{+AUDITOR_WRITER}; pipe($self->{+RENDERER_READER}, $self->{+AUDITOR_WRITER}) or die "Could not create pipe: $!"; _resize_pipe($self->{+AUDITOR_WRITER}); return $self->{+AUDITOR_WRITER}; } sub workdir { my $self = shift; $self->settings->workspace->workdir; } sub ipc { my $self = shift; return $self->{+IPC} //= Test2::Harness::IPC->new( handlers => { INT => sub { $self->handle_sig(@_) }, TERM => sub { $self->handle_sig(@_) }, } ); } sub handle_sig { my $self = shift; my ($sig) = @_; eval { $_->signal($sig) } for grep { $_->can('signal') } @{$self->renderers}; print STDERR "\nCaught SIG$sig, forwarding signal to child processes...\n"; $self->ipc->killall($sig); if ($self->{+SIGNAL}) { print STDERR "\nSecond signal ($self->{+SIGNAL} followed by $sig), exiting now without waiting\n"; exit 1; } $self->{+SIGNAL} = $sig; } sub monitor_preloads { 0 } sub run { my $self = shift; my $settings = $self->settings; my $plugins = $self->settings->harness->plugins; if ($self->start()) { $self->render(); $self->stop(); my $final_data = $self->{+FINAL_DATA} or die "Final data never received from auditor!\n"; my $pass = $self->{+TESTS_SEEN} && $final_data->{pass}; $self->render_final_data($final_data); $self->produce_summary($pass); if (@$plugins) { my %args = ( settings => $settings, final_data => $final_data, pass => $pass ? 1 : 0, tests_seen => $self->{+TESTS_SEEN} // 0, asserts_seen => $self->{+ASSERTS_SEEN} // 0, ); $_->finish(%args) for @$plugins; } return $pass ? 0 : 1; } $self->stop(); return 1; } sub DESTROY { my $self = shift; local ($?, $!, $@, $_); my $cleanup = delete $self->{+CLEANUP_SUBS} or return; for my $sub (@$cleanup) { eval { $sub->(); 1 } or warn $@; } } sub write_test_info { my $self = shift; return if $ENV{TEST2_HARNESS_NO_WRITE_TEST_INFO}; my $info_file = "./.test_info.$$.json"; my $workdir = $self->workdir; Test2::Harness::Util::File::JSON->new(name => $info_file)->write({ workdir => $self->workdir, job_count => $self->job_count, }); push @{$self->{+CLEANUP_SUBS}} => sub { return unless -e $info_file; return unless Test2::Harness::Util::File::JSON->new(name => $info_file)->read->{workdir} eq $workdir; unlink($info_file) or die "Could not unlink info file: $!"; }; $ENV{TEST2_HARNESS_NO_WRITE_TEST_INFO} = 1; } sub start { my $self = shift; $self->ipc->start(); $self->parse_args; $self->write_settings_to($self->workdir, 'settings.json'); $self->write_test_info(); my $pop = $self->populate_queue(); $self->terminate_queue(); return unless $pop; $self->setup_plugins(); $self->setup_resources(); $self->start_runner(jobs_todo => $pop); $self->start_collector(); $self->start_auditor(); return 1; } sub render { my $self = shift; my $ipc = $self->ipc; my $settings = $self->settings; my $renderers = $self->renderers; my $logger = $self->logger; my $plugins = $self->settings->harness->plugins; my $handle_plugins = [grep { $_->can('handle_event') } @$plugins]; my $annotate_plugins = [grep { $_->can('annotate_event') } @$plugins]; # render results from log my $reader = $self->renderer_reader(); $reader->blocking(0); my $buffer; while (1) { return if $self->{+SIGNAL}; $_->step for @{$renderers}; my $line = <$reader>; unless(defined $line) { $ipc->wait() if $ipc; sleep 0.02; next; } if ($buffer) { $line = $buffer . $line; $buffer = undef; } unless (substr($line, -1, 1) eq "\n") { $buffer //= ""; $buffer .= $line; next; } my $e = decode_json($line); if (defined $e) { bless($e, 'Test2::Harness::Event'); my $fd = $e->{facet_data} //= {}; my $changed = 0; for my $p (@$annotate_plugins) { my %inject = $p->annotate_event($e, $settings); next unless keys %inject; $changed++; # Can add new facets, but not modify existing ones. # Someone could force the issue by modifying the event directly # inside 'annotate_event', this is not supported, but also not # forbidden, user beware. for my $f (keys %inject) { if (exists $fd->{$f}) { if ('ARRAY' eq ref($fd->{$f})) { push @{$fd->{$f}} => @{$inject{$f}}; } else { warn "Plugin '$p' tried to add facet '$f' via 'annotate_event()', but it is already present and not a list, ignoring plugin annotation.\n"; } } else { $fd->{$f} = $inject{$f}; } } } if ($logger) { if ($changed) { my $newline = $e->as_json; print $logger $newline, "\n"; } else { print $logger $line; } } } else { last; } if (my $final = $e->{facet_data}->{harness_final}) { $self->{+FINAL_DATA} = $final; } $_->render_event($e) for @$renderers; $self->{+TESTS_SEEN}++ if $e->{facet_data}->{harness_job_launch}; $self->{+ASSERTS_SEEN}++ if $e->{facet_data}->{assert}; $_->handle_event($e, $settings) for @$handle_plugins; $ipc->wait() if $ipc; } } sub get_job_pid { my $self = shift; my ($run_id, $job_id) = @_; return undef unless $run_id && $job_id; my $run_dir = File::Spec->catdir($self->workdir, $run_id); my $jobs_file = File::Spec->catfile($run_dir, 'jobs.jsonl'); return undef unless -f $jobs_file; my $queue = Test2::Harness::Util::Queue->new(file => $jobs_file); my $found; for my $item ($queue->poll) { my $task = $item->[-1]; next unless $task->{job_id} && $task->{job_id} eq $job_id; $found = $task; } return undef unless $found; return $found->{pid} // undef; } sub stop { my $self = shift; my $settings = $self->settings; my $renderers = $self->renderers; my $logger = $self->logger; $self->teardown_plugins($renderers, $logger); if ($logger) { print $logger "null\n"; close($logger); } $_->finish() for @$renderers; my $ipc = $self->ipc; print STDERR "Waiting for child processes to exit...\n" if $self->{+SIGNAL}; if ($self->{+SIGNAL}) { my $state = $self->state; delete $state->{no_poll}; $state->poll; my $running = $state->running_tasks; $state->halt_run($self->{+RUN_ID}); for my $task (values %$running) { next unless $task->{run_id} && $task->{run_id} eq $self->{+RUN_ID}; my $pid = $self->get_job_pid($task->{run_id}, $task->{job_id}) // next; my $file = $task->{rel_file}; print "Killing test $pid - $file...\n"; kill('INT', $pid); } } $ipc->wait(all => 1); $ipc->stop; unless ($settings->display->quiet > 2) { printf STDERR "\nNo tests were seen!\n" unless $self->{+TESTS_SEEN}; printf("\nKeeping work dir: %s\n", $self->workdir) if $settings->debug->keep_dirs; if ($settings->logging->log) { print "\n"; print "Wrote log file: " . $settings->logging->log_file . "\n"; print " (Symlinked to: " . $self->{+LAST_LOG} . ")\n"; } $self->finalize_plugins(); } } sub terminate_queue { my $self = shift; $self->tasks_queue->end(); $self->state->end_queue(); } sub build_run { my $self = shift; return $self->{+RUN} if $self->{+RUN}; my $settings = $self->settings; my $dir = $self->workdir; my $run = $settings->build(run => 'Test2::Harness::Run'); mkdir($run->run_dir($dir)) or die "Could not make run dir: $!"; chmod_tmp($dir); return $self->{+RUN} = $run; } sub state { my $self = shift; $self->{+STATE} //= Test2::Harness::Runner::State->new( workdir => $self->workdir, job_count => $self->job_count, no_poll => 1, ); } sub job_count { my $self = shift; return $self->settings->runner->job_count; } sub run_queue { my $self = shift; my $dir = $self->workdir; return $self->{+RUN_QUEUE} //= Test2::Harness::Util::Queue->new(file => File::Spec->catfile($dir, 'run_queue.jsonl')); } sub tasks_queue { my $self = shift; $self->{+TASKS_QUEUE} //= Test2::Harness::Util::Queue->new( file => File::Spec->catfile($self->build_run->run_dir($self->workdir), 'queue.jsonl'), ); } sub finder_args {()} sub populate_queue { my $self = shift; my $run = $self->build_run(); $self->{+RUN_ID} = $run->run_id; my $settings = $self->settings; my $finder = $settings->build(finder => $settings->finder->finder, $self->finder_args); my $state = $self->state; my $tasks_queue = $self->tasks_queue; my $plugins = $settings->harness->plugins; $state->queue_run($run->queue_item($plugins)); my @files = @{$finder->find_files($plugins, $self->settings)}; for my $plugin (@$plugins) { if ($plugin->can('sort_files_2')) { @files = $plugin->sort_files_2(settings => $settings, files => \@files); } elsif ($plugin->can('sort_files')) { @files = $plugin->sort_files(@files); } } my $job_count = 0; for my $file (@files) { my $task = $file->queue_item(++$job_count, $run->run_id, $settings->check_prefix('display') ? (verbose => $settings->display->verbose) : (), ); $task->{category} = 'isolation' if $settings->debug->interactive; $state->queue_task($task); $tasks_queue->enqueue($task); } $state->stop_run($run->run_id); return $job_count; } sub produce_summary { my $self = shift; my ($pass) = @_; my $settings = $self->settings; my $time_data = { start => $settings->harness->start, stop => time(), }; $time_data->{wall} = $time_data->{stop} - $time_data->{start}; my @times = times(); @{$time_data}{qw/user system cuser csystem/} = @times; $time_data->{cpu} = sum @times; my $cpu_usage = int($time_data->{cpu} / $time_data->{wall} * 100); $self->write_summary($pass, $time_data, $cpu_usage); $self->render_summary($pass, $time_data, $cpu_usage); } sub write_summary { my $self = shift; my ($pass, $time_data, $cpu_usage) = @_; my $file = $self->settings->debug->summary or return; my $final_data = $self->{+FINAL_DATA}; my $failures = @{$final_data->{failed} // []}; my %data = ( %$final_data, pass => $pass ? JSON->true : JSON->false, total_failures => $failures // 0, total_tests => $self->{+TESTS_SEEN} // 0, total_asserts => $self->{+ASSERTS_SEEN} // 0, cpu_usage => $cpu_usage, times => $time_data, ); require Test2::Harness::Util::File::JSON; my $jfile = Test2::Harness::Util::File::JSON->new(name => $file); $jfile->write(\%data); print "\nWrote summary file: $file\n\n"; return; } sub render_summary { my $self = shift; my ($pass, $time_data, $cpu_usage) = @_; return if $self->settings->display->quiet > 1; my $final_data = $self->{+FINAL_DATA}; my $failures = @{$final_data->{failed} // []}; my @summary = ( $failures ? (" Fail Count: $failures") : (), " File Count: $self->{+TESTS_SEEN}", "Assertion Count: $self->{+ASSERTS_SEEN}", $time_data ? ( sprintf(" Wall Time: %.2f seconds", $time_data->{wall}), sprintf(" CPU Time: %.2f seconds (usr: %.2fs | sys: %.2fs | cusr: %.2fs | csys: %.2fs)", @{$time_data}{qw/cpu user system cuser csystem/}), sprintf(" CPU Usage: %i%%", $cpu_usage), ) : (), ); my $res = " --> Result: " . ($pass ? 'PASSED' : 'FAILED') . " <--"; if ($self->settings->display->color && USE_ANSI_COLOR) { my $color = $pass ? Term::ANSIColor::color('bold bright_green') : Term::ANSIColor::color('bold bright_red'); my $reset = Term::ANSIColor::color('reset'); $res = "$color$res$reset"; } push @summary => $res; my $msg = "Yath Result Summary"; my $length = max map { length($_) } @summary; my $prefix = ($length - length($msg)) / 2; print "\n"; print " " x $prefix; print "$msg\n"; print "-" x $length; print "\n"; print join "\n" => @summary; print "\n"; } sub render_final_data { my $self = shift; my ($final_data) = @_; return if $self->settings->display->quiet > 1; if (my $rows = $final_data->{retried}) { print "\nThe following jobs failed at least once:\n"; print join "\n" => table( header => ['Job ID', 'Times Run', 'Test File', "Succeeded Eventually?"], rows => $rows, ); print "\n"; } if (my $rows = $final_data->{failed}) { print "\nThe following jobs failed:\n"; print join "\n" => table( collapse => 1, header => ['Job ID', 'Test File', 'Subtests'], rows => [map { my $r = [@{$_}]; $r->[2] = stringify_subtest_map($r->[2]) if $r->[2]; $r} @$rows], ); print "\n"; } if (my $rows = $final_data->{halted}) { print "\nThe following jobs requested all testing be halted:\n"; print join "\n" => table( header => ['Job ID', 'Test File', "Reason"], rows => $rows, ); print "\n"; } if (my $rows = $final_data->{unseen}) { print "\nThe following jobs never ran:\n"; print join "\n" => table( header => ['Job ID', 'Test File'], rows => $rows, ); print "\n"; } } sub stringify_subtest_map { my ($map) = @_; my $out = ""; my @todo = @$map; my @state; while (my $st = shift @todo) { if (!ref($st)) { pop @state if $st eq 'pop'; next; } push @state => $st->[0]; $out .= join(' -> ' => @state) . "\n"; unshift @todo => (@{$st->[1]}, 'pop'); } return $out; } sub logger { my $self = shift; return $self->{+LOGGER} if $self->{+LOGGER}; my $settings = $self->{+SETTINGS}; return unless $settings->logging->log; my $file = $settings->logging->log_file; if ($settings->logging->bzip2) { no warnings 'once'; require IO::Compress::Bzip2; $self->{+LOGGER} = IO::Compress::Bzip2->new($file) or die "Could not open log file '$file': $IO::Compress::Bzip2::Bzip2Error"; } elsif ($settings->logging->gzip) { no warnings 'once'; require IO::Compress::Gzip; $self->{+LOGGER} = IO::Compress::Gzip->new($file) or die "Could not open log file '$file': $IO::Compress::Gzip::GzipError"; } else { $self->{+LOGGER} = open_file($file, '>'); } for my $ext ('jsonl', 'jsonl.bz2', 'jsonl.gz') { my $name = "./lastlog.$ext"; next unless -f $name; local ($!, $@) = (0, ''); eval { unlink($name) } or warn "Could not unlink '$name': ($!) $@"; } if ($file =~ m/\.(jsonl(?:\.(?:bz2|gz))?)$/) { my $ext = $1; my $name = "./lastlog.$ext"; if (eval { symlink($file, $name); 1 }) { $self->{+LAST_LOG} = $name; } else { warn "Could not symlink the log file to '$name': $@"; } } return $self->{+LOGGER}; } sub renderers { my $self = shift; return $self->{+RENDERERS} if $self->{+RENDERERS}; my $settings = $self->{+SETTINGS}; my @renderers; for my $class (@{$settings->display->renderers->{'@'}}) { require(mod2file($class)); my $args = $settings->display->renderers->{$class}; my $renderer = $class->new(@$args, settings => $settings, command_class => ref($self)); push @renderers => $renderer; } return $self->{+RENDERERS} = \@renderers; } sub start_auditor { my $self = shift; my $run = $self->build_run(); my $settings = $self->settings; my $ipc = $self->ipc; $ipc->spawn( stdin => $self->auditor_reader(), stdout => $self->auditor_writer(), no_set_pgrp => 1, command => [ $^X, $self->spawn_args($settings), $settings->harness->script, (map { "-D$_" } @{$settings->harness->dev_libs}), '--no-scan-plugins', # Do not preload any plugin modules auditor => 'Test2::Harness::Auditor', $run->run_id, procname_prefix => $settings->debug->procname_prefix, ], ); close($self->auditor_writer()); } sub collector_options { () } sub start_collector { my $self = shift; my $dir = $self->workdir; my $run = $self->build_run(); my $settings = $self->settings; my $runner_pid = $self->runner_pid; my ($rh, $wh); pipe($rh, $wh) or die "Could not create pipe"; my %options = (show_runner_output => 1); if ($settings->check_prefix('display')) { $options{show_runner_output} = $settings->display->hide_runner_output ? 0 : 1; $options{truncate_runner_output} = $settings->display->truncate_runner_output; } %options = ( %options, $self->collector_options(), ); my $ipc = $self->ipc; $ipc->spawn( stdout => $self->collector_writer, stdin => $rh, no_set_pgrp => 1, command => [ $^X, $self->spawn_args($settings), $settings->harness->script, (map { "-D$_" } @{$settings->harness->dev_libs}), '--no-scan-plugins', # Do not preload any plugin modules collector => 'Test2::Harness::Collector', $dir, $run->run_id, $runner_pid, %options, ], ); close($rh); print $wh encode_json($run) . "\n"; close($wh); close($self->collector_writer()); } sub start_runner { my $self = shift; my %args = @_; $args{monitor_preloads} //= $self->monitor_preloads; my $settings = $self->settings; my $dir = $settings->workspace->workdir; my @prof; if ($settings->runner->nytprof) { push @prof => '-d:NYTProf'; } my $ipc = $self->ipc; my $proc = $ipc->spawn( stderr => File::Spec->catfile($dir, 'error.log'), stdout => File::Spec->catfile($dir, 'output.log'), env_vars => { @prof ? (NYTPROF => 'start=no:addpid=1') : () }, no_set_pgrp => 1, command => [ $^X, @prof, $self->spawn_args($settings), $settings->harness->script, (map { "-D$_" } @{$settings->harness->dev_libs}), '--no-scan-plugins', # Do not preload any plugin modules runner => $dir, %args, ], ); $self->{+RUNNER_PID} = $proc->pid; return $proc; } sub parse_args { my $self = shift; my $settings = $self->settings; my $args = $self->args; my $dest = $settings->finder->search; for my $arg (@$args) { next if $arg eq '--'; if ($arg eq '::') { $dest = $settings->run->test_args; next; } push @$dest => $arg; } return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::test - Run tests =head1 DESCRIPTION This yath command (which is also the default command) will run all the test files for the current project. If no test files are specified this command will look for the 't', and 't2' directories, as well as the 'test.pl' file. This command is always recursive when given directories. This command will add 'lib', 'blib/arch' and 'blib/lib' to the perl path for you by default (after any -I's). You can specify -l if you just want lib, -b if you just want the blib paths. If you specify both -l and -b both will be added in the order you specify (order relative to any -I options will also be preserved. If you do not specify they will be added in this order: -I's, lib, blib/lib, blib/arch. You can also add --no-lib and --no-blib to avoid both. Any command line argument that is not an option will be treated as a test file or directory of test files to be run. If you wish to specify the ARGV for tests you may append them after '::'. This is mainly useful for Test::Class::Moose and similar tools. EVERY test run will get the same ARGV. =head1 USAGE $ yath [YATH OPTIONS] test [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Collector Options =over 4 =item --max-open-jobs 18 =item --no-max-open-jobs Maximum number of jobs a collector can process at a time, if more jobs are pending their output will be delayed until the earlier jobs have been processed. (Default: double the -j value) =item --max-poll-events 1000 =item --no-max-poll-events Maximum number of events to poll from a job before jumping to the next job. (Default: 1000) =back =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used ot set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C, C =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 Runner Options =over 4 =item --abort-on-bail =item --no-abort-on-bail Abort all testing if a bail-out is encountered (default: on) =item --blib =item -b =item --no-blib (Default: include if it exists) Include 'blib/lib' and 'blib/arch' in your module path =item --cover =item --cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --no-cover Use Devel::Cover to calculate test coverage. This disables forking. If no args are specified the following are used: -silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --dump-depmap =item --no-dump-depmap When using staged preload, dump the depmap for each stage as json files =item --event-timeout SECONDS =item --et SECONDS =item --no-event-timeout Kill test if no output is received within timeout period. (Default: 60 seconds). Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. This prevents a hung test from running forever. =item --include ARG =item --include=ARG =item -I ARG =item -I=ARG =item --no-include Add a directory to your include paths Can be specified multiple times =item --job-count 4 =item --job-count 8:2 =item --jobs 4 =item --jobs 8:2 =item -j4 =item -j8:2 =item --no-job-count Set the number of concurrent jobs to run. Add a :# if you also wish to designate multiple slots per test. 8:2 means 8 slots, but each test gets 2 slots, so 4 tests run concurrently. Tests can find their concurrency assignemnt in the "T2_HARNESS_MY_JOB_CONCURRENCY" environment variable. Can also be set with the following environment variables: C, C, C =item --lib =item -l =item --no-lib (Default: include if it exists) Include 'lib' in your module path =item --nytprof =item --no-nytprof Use Devel::NYTProf on tests. This will set addpid=1 for you. This works with or without fork. =item --post-exit-timeout SECONDS =item --pet SECONDS =item --no-post-exit-timeout Stop waiting post-exit after the timeout period. (Default: 15 seconds) Some tests fork and allow the parent to exit before writing all their output. If Test2::Harness detects an incomplete plan after the test exits it will monitor for more events until the timeout period. Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. =item --preload-threshold ARG =item --preload-threshold=ARG =item --Pt ARG =item --Pt=ARG =item -W ARG =item -W=ARG =item --no-preload-threshold Only do preload if at least N tests are going to be run. In some cases a full preload takes longer than simply running the tests, this lets you specify a minimum number of test jobs that will be run for preload to happen. This has no effect for a persistent runner. The default is 0, and it means always preload. =item --preloads ARG =item --preloads=ARG =item --preload ARG =item --preload=ARG =item -P ARG =item -P=ARG =item --no-preloads Preload a module before running tests Can be specified multiple times =item --resource Port =item --resource +Test2::Harness::Runner::Resource::Port =item -R Port =item --no-resource Use a resource module to assign resource assignments to individual tests Can be specified multiple times =item --runner-id ARG =item --runner-id=ARG =item --no-runner-id Runner ID (usually a generated uuid) =item --shared-jobs-config .sharedjobslots.yml =item --shared-jobs-config relative/path/.sharedjobslots.yml =item --shared-jobs-config /absolute/path/.sharedjobslots.yml =item --no-shared-jobs-config Where to look for a shared slot config file. If a filename with no path is provided yath will search the current and all parent directories for the name. =item --slots-per-job 2 =item -x2 =item --no-slots-per-job This sets the number of slots each job will use (default 1). This is normally set by the ':#' in '-j#:#'. Can also be set with the following environment variables: C =item --switch ARG =item --switch=ARG =item -S ARG =item -S=ARG =item --no-switch Pass the specified switch to perl for each test. This is not compatible with preload. Can be specified multiple times =item --tlib =item --no-tlib (Default: off) Include 't/lib' in your module path =item --unsafe-inc =item --no-unsafe-inc perl is removing '.' from @INC as a security concern. This option keeps things from breaking for now. Can also be set with the following environment variables: C =item --use-fork =item --fork =item --no-use-fork (default: on, except on windows) Normally tests are run by forking, which allows for features like preloading. This will turn off the behavior globally (which is not compatible with preloading). This is slower, it is better to tag misbehaving tests with the '# HARNESS-NO-PRELOAD' comment in their header to disable forking only for those tests. Can also be set with the following environment variables: C, C, C, C, C =item --use-timeout =item --timeout =item --no-use-timeout (default: on) Enable/disable timeouts =back =head3 Workspace Options =over 4 =item --clear =item -C =item --no-clear Clear the work directory if it is not already empty =item --tmp-dir ARG =item --tmp-dir=ARG =item --tmpdir ARG =item --tmpdir=ARG =item -t ARG =item -t=ARG =item --no-tmp-dir Use a specific temp directory (Default: use system temp dir) Can also be set with the following environment variables: C, C, C, C, C, C =item --workdir ARG =item --workdir=ARG =item -w ARG =item -w=ARG =item --no-workdir Set the work directory (Default: new temp directory) Can also be set with the following environment variables: C, C =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/init.pm0000644000175000017500000003166315012417054021354 0ustar exodistexodistpackage App::Yath::Command::init; use strict; use warnings; use parent 'App::Yath::Command'; our $VERSION = '1.000158'; use Test2::Harness::Util qw/open_file/; use App::Yath::Util qw/is_generated_test_pl/; sub group { 'zinit' } sub summary { "Create/update test.pl to run tests via Test2::Harness" } sub description { return <<" EOT"; This command will create or update the 'test.pl' file in the current directory. This 'test.pl' file this creates will run all your tests via yath. This command will fail if there is already a test.pl file that does not look like it was generated by this command. EOT } sub run { die "'test.pl' already exists, and does not appear to be a yath runner.\n" if -f 'test.pl' && !is_generated_test_pl('test.pl'); print "\nWriting test.pl...\n\n"; my $fh = open_file('test.pl', '>'); print $fh <<' EOT'; #!/usr/bin/env perl # HARNESS-NO-PRELOAD # HARNESS-CAT-LONG # THIS IS A GENERATED YATH RUNNER TEST use strict; use warnings; use lib 'lib'; use App::Yath::Util qw/find_yath/; system($^X, find_yath(), '-D', 'test', '--default-search' => './t', '--default-search' => './t2', @ARGV); my $exit = $?; # This makes sure it works with prove. print "1..1\n"; print "not " if $exit; print "ok 1 - Passed tests when run by yath\n"; print STDERR "yath exited with $exit" if $exit; exit($exit ? 255 : 0); EOT return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::init - Create/update test.pl to run tests via Test2::Harness =head1 DESCRIPTION This command will create or update the 'test.pl' file in the current directory. This 'test.pl' file this creates will run all your tests via yath. This command will fail if there is already a test.pl file that does not look like it was generated by this command. =head1 USAGE $ yath [YATH OPTIONS] init [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/stop.pm0000644000175000017500000007504515012417054021400 0ustar exodistexodistpackage App::Yath::Command::stop; use strict; use warnings; our $VERSION = '1.000158'; use Time::HiRes qw/sleep/; use File::Spec(); use Test2::Harness::Util::File::JSON(); use Test2::Harness::Util::Queue(); use Test2::Harness::Util qw/open_file/; use App::Yath::Util qw/find_pfile/; use File::Path qw/remove_tree/; use parent 'App::Yath::Command::run'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Stop the persistent test runner" } sub cli_args { "" } sub description { return <<" EOT"; This command will stop a persistent instance, and output any log contents. EOT } sub pfile_params { (no_fatal => 1) } sub run { my $self = shift; $self->App::Yath::Command::test::terminate_queue(); $_->teardown($self->settings) for @{$self->settings->harness->plugins}; sleep(0.02) while kill(0, $self->pfile_data->{pid}); my $pfile = $self->pfile; unlink($pfile) if -f $pfile; remove_tree($self->workdir, {safe => 1, keep_root => 0}) if -d $self->workdir; print "\n\nRunner stopped\n\n" unless $self->settings->display->quiet; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::stop - Stop the persistent test runner =head1 DESCRIPTION This command will stop a persistent instance, and output any log contents. =head1 USAGE $ yath [YATH OPTIONS] stop [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used ot set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C, C =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head3 NO CATEGORY - FIX ME =over 4 =item --check-reload-state =item --no-check-reload-state Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/run.pm0000644000175000017500000010644015012417054021211 0ustar exodistexodistpackage App::Yath::Command::run; use strict; use warnings; our $VERSION = '1.000158'; use App::Yath::Options; use Test2::Harness::Run; use Test2::Harness::Util::Queue; use Test2::Harness::Util::File::JSON; use Test2::Harness::IPC; use App::Yath::Util qw/find_pfile/; use Test2::Harness::Util qw/open_file/; use Test2::Harness::Util qw/mod2file open_file/; use Test2::Util::Table qw/table/; use File::Spec; use Carp qw/croak/; use parent 'App::Yath::Command::test'; use Test2::Harness::Util::HashBase qw/+pfile_data +pfile/; include_options( 'App::Yath::Options::Debug', 'App::Yath::Options::Display', 'App::Yath::Options::Finder', 'App::Yath::Options::Logging', 'App::Yath::Options::PreCommand', 'App::Yath::Options::Run', ); option_group {prefix => 'run'} => sub { option check_reload_state => ( type => 'b', description => 'Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings.', default => 1, ); }; sub group { 'persist' } sub summary { "Run tests using the persistent test runner" } sub cli_args { '[--] [test files/dirs] [::] [arguments to test scripts] [test_file.t] [test_file2.t="--arg1 --arg2 --param=\'foo bar\'"] [:: --argv-for-all-tests]' } sub description { return <<" EOT"; This command will run tests through an already started persistent instance. See the start command for details on how to launch a persistant instance. EOT } sub terminate_queue {} sub write_settings_to {} sub setup_plugins {} sub setup_resources {} sub teardown_plugins {} sub finalize_plugins {} sub pfile_params { () } sub monitor_preloads { 1 } sub job_count { 1 } sub collector_options { (persistent_runner => 1) } sub run { my $self = shift; my $settings = $self->settings; if ($settings->run->check_reload_state) { return 255 unless $self->check_reload_state; } return $self->SUPER::run(@_); } sub write_test_info { $ENV{TEST2_HARNESS_NO_WRITE_TEST_INFO} //= 1; } sub check_reload_state { my $self = shift; my $state = Test2::Harness::Runner::State->new( workdir => $self->workdir, observe => 1, ); $state->poll; my $reload_status = $state->reload_state // {}; my (@out, $errors, $warnings, %seen); for my $stage (sort keys %$reload_status) { for my $file (keys %{$reload_status->{$stage}}) { next if $seen{$file}++; my $data = $reload_status->{$stage}->{$file} or next; push @out => "\n==== SOURCE FILE: $file ====\n"; if ($data->{error}) { $errors++; push @out => $data->{error}; } for (@{$data->{warnings} // []}) { push @out => $_; $warnings++; } } } $errors //= 0; $warnings //= 0; return 1 unless @out || $errors || $warnings; print <<" EOT", @out; ******************************************************************************* * Some source files were reloaded with errors or warnings * Errors: $errors * Warnings: $warnings ******************************************************************************* EOT if ($errors) { print <<" EOT"; ******************************************************************************* Aborting due to reload errors. Please fix the errors so that the modules reload cleanly, then try the run again. In most cases you will not need to reload the runner, simply fix the problem with the source file(s) and the runner will reload them automatically. EOT return 0; } elsif ($warnings) { print <<" EOT"; ******************************************************************************* Warnings were encountered when reloading source files, please see the output above. If these warnings are a problem you should abort this run (control+c) and correct them before trying again. In most cases you will not need to reload the runner, simply fix the problem with the source file(s) and the runner will reload them automatically. If these warnings are not indicitive of a problem you may continue by pressing enter/return. EOT if (-t STDIN) { my $ignore = ; return 1; } else { print STDERR "No TTY detected, aborting run due to warnings...\n"; return 0; } } return 0; } sub init { my $self = shift; my $settings = $self->settings; my $pdata = $self->pfile_data; my $runner_settings = Test2::Harness::Util::File::JSON->new(name => $pdata->{dir} . '/settings.json')->read(); for my $prefix (sort keys %{$runner_settings}) { next if $settings->check_prefix($prefix); my $new = $settings->define_prefix($prefix); ${$new->vivify_field('from_runner')} = 1; for my $key (sort keys %{$runner_settings->{$prefix}}) { ${$new->vivify_field($key)} = $runner_settings->{$prefix}->{$key}; } } return $self->SUPER::init(@_); } sub pfile { my $self = shift; $self->{+PFILE} //= find_pfile($self->settings, $self->pfile_params) or die "No persistent harness was found for the current path.\n"; } sub pfile_data { my $self = shift; return $self->{+PFILE_DATA} if $self->{+PFILE_DATA}; my $pfile = $self->pfile; my $data = Test2::Harness::Util::File::JSON->new(name => $pfile)->read(); $data->{pfile_path} //= $pfile; print "\nFound: $data->{pfile_path}\n"; print " PID: $data->{pid}\n"; print " Dir: $data->{dir}\n"; return $self->{+PFILE_DATA} = $data; } sub workdir { my $self = shift; return $self->pfile_data->{dir}; } sub start_runner { my $self = shift; my $data = $self->pfile_data; $self->{+RUNNER_PID} = $data->{pid}; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::run - Run tests using the persistent test runner =head1 DESCRIPTION This command will run tests through an already started persistent instance. See the start command for details on how to launch a persistant instance. =head1 USAGE $ yath [YATH OPTIONS] run [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used ot set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C, C =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head3 NO CATEGORY - FIX ME =over 4 =item --check-reload-state =item --no-check-reload-state Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/do.pm0000644000175000017500000003055515012417054021012 0ustar exodistexodistpackage App::Yath::Command::do; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Harness::Util::File::JSON; use Test2::Harness::Util qw/open_file/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub group { '' } sub summary { "Run tests using 'run' or 'test', same as the default command, but explicit." } sub cli_args { "[run or test args]" } sub description { return <<" EOT"; This is the same as running yath without a command, except that it will not fail on CLI parsing issues that often get mistaken for commands. If there is a persistent runner then the 'run' command is used, otherwise the 'test' command is used. EOT } sub run { # This file is actually just a stub for the magic of 'do'. Code is not executed. die "This should not be reachable"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::do - Run tests using 'run' or 'test', same as the default command, but explicit. =head1 DESCRIPTION This is the same as running yath without a command, except that it will not fail on CLI parsing issues that often get mistaken for commands. If there is a persistent runner then the 'run' command is used, otherwise the 'test' command is used. =head1 USAGE $ yath [YATH OPTIONS] do [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Command/ps.pm0000644000175000017500000007571715012417054021043 0ustar exodistexodistpackage App::Yath::Command::ps; use strict; use warnings; our $VERSION = '1.000158'; use Term::Table(); use File::Spec(); use App::Yath::Util qw/find_pfile/; use Test2::Harness::Runner::State; use Test2::Harness::Util::File::JSON(); use Test2::Harness::Util::Queue(); use parent 'App::Yath::Command::status'; use Test2::Harness::Util::HashBase qw/queue/; sub group { 'persist' } sub summary { "Process list for the runner" } sub cli_args { "" } sub description { return <<" EOT"; List all running processes and runner stages. EOT } sub pfile_params { (no_fatal => 1) } sub run { my $self = shift; my $data = $self->pfile_data(); my $state = Test2::Harness::Runner::State->new( workdir => $self->workdir, observe => 1, ); $state->poll; my @jobs; my $stage_status = $state->stage_readiness // {}; for my $stage (keys %$stage_status) { my $pid = $stage_status->{$stage} // next; $pid = 'N/A' if $pid == 1; push @jobs => [$pid, "Runner Stage", $stage]; } my $running = $state->running_tasks; for my $task (values %$running) { my $pid = $self->get_job_pid($task->{run_id}, $task->{job_id}) // 'N/A'; my $file = $task->{rel_file}; push @jobs => [$pid, "Running Test", $file]; } my $process_table = Term::Table->new( collapse => 1, header => [qw/pid type name/], rows => [sort { $a->[0] <=> $b->[0] } @jobs], ); print "\n**** Running Processes ****\n"; print "$_\n" for $process_table->render; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::ps - Process list for the runner =head1 DESCRIPTION List all running processes and runner stages. =head1 USAGE $ yath [YATH OPTIONS] ps [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will coninue if even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used ot set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C, C =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-db =item --no-yathui-db Add the YathUI DB renderer in addition to other renderers =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-only =item --no-yathui-only Only use the YathUI renderer =item --yathui-only-db =item --no-yathui-only-db Only use the YathUI DB renderer =item --yathui-port 8080 =item --no-yathui-port Port to use when running a local server =item --yathui-port-command get_port.sh =item --yathui-port-command get_port.sh --pid $$ =item --no-yathui-port-command Use a command to get a port number. "$$" will be replaced with the PID of the yath process =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-render =item --no-yathui-render Add the YathUI renderer in addition to other renderers =item --yathui-resources =item --yathui-resources=5 =item --no-yathui-resources Send resource info (for supported resources) to yathui at the specified interval in seconds (5 if not specified) =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-schema PostgreSQL =item --yathui-schema MySQL =item --yathui-schema MySQL56 =item --no-yathui-schema What type of DB/schema to use when using a temporary database =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =item --yathui-user ARG =item --yathui-user=ARG =item --no-yathui-user Username to attach to the data sent to the db =item --yathui-db-buffering none =item --yathui-db-buffering job =item --yathui-db-buffering diag =item --yathui-db-buffering run =item --no-yathui-db-buffering Type of buffering to use, if "none" then events are written to the db one at a time, which is SLOW =item --yathui-db-config ARG =item --yathui-db-config=ARG =item --no-yathui-db-config Module that implements 'MODULE->yath_ui_config(%params)' which should return a Test2::Harness::UI::Config instance. =item --yathui-db-coverage =item --no-yathui-db-coverage Pull coverage data directly from the database (default: off) =item --yathui-db-driver Pg =item --yathui-db-drivermysql =item --yathui-db-driverMariaDB =item --no-yathui-db-driver DBI Driver to use =item --yathui-db-dsn ARG =item --yathui-db-dsn=ARG =item --no-yathui-db-dsn DSN to use when connecting to the db =item --yathui-db-duration-limit ARG =item --yathui-db-duration-limit=ARG =item --no-yathui-db-duration-limit Limit the number of runs to look at for durations data (default: 10) =item --yathui-db-durations =item --no-yathui-db-durations Pull duration data directly from the database (default: off) =item --yathui-db-flush-interval 2 =item --yathui-db-flush-interval 1.5 =item --no-yathui-db-flush-interval When buffering DB writes, force a flush when an event is recieved at least N seconds after the last flush. =item --yathui-db-host ARG =item --yathui-db-host=ARG =item --no-yathui-db-host hostname to use when connecting to the db =item --yathui-db-name ARG =item --yathui-db-name=ARG =item --no-yathui-db-name Name of the database to use for yathui =item --yathui-db-pass ARG =item --yathui-db-pass=ARG =item --no-yathui-db-pass Password to use when connecting to the db =item --yathui-db-port ARG =item --yathui-db-port=ARG =item --no-yathui-db-port port to use when connecting to the db =item --yathui-db-publisher ARG =item --yathui-db-publisher=ARG =item --no-yathui-db-publisher When using coverage or duration data, only use data uploaded by this user =item --yathui-db-socket ARG =item --yathui-db-socket=ARG =item --no-yathui-db-socket socket to use when connecting to the db =item --yathui-db-user ARG =item --yathui-db-user=ARG =item --no-yathui-db-user Username to use when connecting to the db =back =head3 NO CATEGORY - FIX ME =over 4 =item --check-reload-state =item --no-check-reload-state Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2025 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Converting.pm0000644000175000017500000000467015012417054021147 0ustar exodistexodistpackage App::Yath::Converting; use strict; use warnings; our $VERSION = '1.000158'; 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Converting - Things you may need to change in your tests before you can use yath. =head1 NON-TAP FORMATTER By default yath tells any L or L tests to use L instead of L. This is done in order to make sure as much data as possible makes it to yath, TAP is a lossy formater by comparison. This is not normally a problem, but tests that do strange things with STDERR/STDOUT, or try to intercept output from the regular TAP formatter can have issues with this. =head2 SOLUTIONS =head3 HARNESS-NO-STREAM You can add a harness directive to the top of offending tests that tell the harness those specific tests should still use the TAP formatter. #!/usr/bin/perl # HARNESS-NO-STREAM ... This directive can come after the C<#!> line, and after use statements, but must come BEFORE any empty lines or runtime statements. =head3 --no-stream You can run yath with the C<--no-stream> option, which will have tests default to TAP. This is not recommended as TAP is lossy. =head1 TESTS ARE RUN VIA FORK BY DEFAULT The default mode for yath is to preload a few things, then fork to spawn each test. This is a complicated procedure, and it uses L under the hood. Sometimes you have tests that simply will not work this way, or tests that verify specific libraries are not already loaded. =head2 SOLUTIONS =head3 HARNESS-NO-PRELOAD You can use this harness directive inside your tests to tell yath not to fork, but to instead launch a new perl process to run the test. #!/usr/bin/perl # HARNESS-NO-PRELOAD ... =head3 --no-fork =head3 --no-preload Both these options tell yath not to preload+fork, but to run ALL tests in new processes. This is slow, it is better to mark specific tests that have issues in preload mode. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =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 2020 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 F =cut Test2-Harness-1.000158/lib/App/Yath/Options.pm0000644000175000017500000005645015012417054020467 0ustar exodistexodistpackage App::Yath::Options; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/croak confess/; use Scalar::Util qw/blessed/; use Test2::Harness::Util qw/mod2file/; use App::Yath::Option(); use Test2::Harness::Settings(); use Test2::Harness::Util::HashBase qw{ new()) }; my $option = sub { ($instance //= $class->new())->_option([caller()], shift(@_), @common ? (%{$common[-1]}) : (), @_) }; my $include = sub { ($instance //= $class->new())->include_from(@_) }; my $post = sub { my $cb = pop; my $weight = shift // 0; my ($applicable) = @_; $applicable //= $common[-1]->{applicable} if @common; croak "You must provide a callback coderef" unless $cb && ref($cb) eq 'CODE'; ($instance //= $class->new())->_post($weight, $applicable, $cb); }; my $group = sub { my ($set, $sub) = @_; my $common = {@common ? (%{$common[-1]}) : (), %$set}; if (my $class = $common->{builds}) { require(mod2file($class)); } push @common => $common; my $ok = eval { $sub->(); 1 }; my $err = $@; pop @common; die $err unless $ok; }; { no strict 'refs'; *{"$caller\::post"} = $post; *{"$caller\::option"} = $option; *{"$caller\::options"} = $options; *{"$caller\::option_group"} = $group; *{"$caller\::include_options"} = $include; } return 1; } sub init { my $self = shift; $self->{+ALL} //= []; $self->{+LOOKUP} //= {}; $self->{+USED_PLUGINS} //= []; $self->{+PRE_LIST} //= []; $self->{+CMD_LIST} //= []; $self->{+POST_LIST} //= []; $self->{+SETTINGS} //= Test2::Harness::Settings->new(); $self->{+INCLUDED} //= {}; $self->{+SET_BY_CLI} //= {}; return $self; } sub option { my $self = shift; $self->_option([caller()], @_); } sub include { my $self = shift; my ($inc) = @_; croak "Include must be an instance of ${ \__PACKAGE__ }, got ${ defined($inc) ? \qq['$inc'] : \'undef' }" unless $inc && blessed($inc) && $inc->isa(__PACKAGE__); $self->include_option($_) for @{$inc->all}; $self->{+POST_LIST_SORTED} = 0; push @{$self->{+POST_LIST}} => @{$inc->post_list}; return; } sub include_from { my $self = shift; for my $pkg (@_) { require(mod2file($pkg)) unless $pkg->can('options'); next unless $pkg->can('options'); my $options = $pkg->options or next; $self->include($options); $self->{+INCLUDED}->{$pkg}++; $self->{+INCLUDED}->{$_}++ for keys %{$options->included}; } return; } sub populate_pre_defaults { my $self = shift; for my $opt (@{$self->_pre_command_options}) { my $slot = $opt->option_slot($self->{+SETTINGS}); my $val = $opt->get_default($self->{+SETTINGS}); $$slot //= $val; } } sub populate_cmd_defaults { my $self = shift; croak "The 'command_class' attribute has not yet been set" unless $self->{+COMMAND_CLASS}; for my $opt (@{$self->_command_options()}) { my $slot = $opt->option_slot($self->{+SETTINGS}); my $val = $opt->get_default($self->{+SETTINGS}); $$slot //= $val; } } sub grab_pre_command_opts { my $self = shift; my %config = @_; $self->populate_pre_defaults(); unshift @{$self->{+PENDING_PRE} //= []} => $self->_grab_opts( '_pre_command_options', 'pre-command', stop_at_non_opt => 1, passthrough => 1, %config, ); } sub process_pre_command_opts { my $self = shift; return unless $self->{+PENDING_PRE}; $self->_process_opts(delete $self->{+PENDING_PRE}); } sub set_command_class { my $self = shift; my ($in) = @_; croak "Command class has already been set" if $self->{+COMMAND_CLASS}; my $class = blessed($in) || $in; croak "Invalid command class: $class" unless $class->isa('App::Yath::Command'); $self->include_from($class) if $class->can('options'); return $self->{+COMMAND_CLASS} = $class; } sub set_args { my $self = shift; my ($in) = @_; croak "'args' has already been set" if $self->{+ARGS}; return $self->{+ARGS} = $in; } sub grab_command_opts { my $self = shift; my %config = @_; croak "The 'command_class' attribute has not yet been set" unless $self->{+COMMAND_CLASS}; $self->populate_cmd_defaults(); push @{$self->{+PENDING_CMD} //= []} => $self->_grab_opts( '_command_options', "command (" . $self->{+COMMAND_CLASS}->name . ")", %config, ); } sub process_command_opts { my $self = shift; return unless $self->{+PENDING_CMD}; $self->_process_opts(delete $self->{+PENDING_CMD}); } sub process_option_post_actions { my $self = shift; my ($cmd) = @_; croak "The 'args' attribute has not yet been set" unless $self->{+ARGS}; if ($cmd) { croak "The 'command_class' attribute has not yet been set" unless $self->{+COMMAND_CLASS}; croak "The process_option_post_actions requires an App::Yath::Command instance, got: " . ($cmd // "undef") unless blessed($cmd) && $cmd->isa('App::Yath::Command'); croak "The command '$cmd' dos not match the expected class '$self->{+COMMAND_CLASS}'" unless blessed($cmd) eq $self->{+COMMAND_CLASS}; } unless ($self->{+POST_LIST_SORTED}++) { @{$self->{+POST_LIST}} = sort { $a->[0] <=> $b->[0] } @{$self->{+POST_LIST}}; } for my $post (@{$self->{+POST_LIST}}) { next if $post->[1] && !$post->[1]->($post->[2], $self); $post->[2]->( options => $self, args => $self->{+ARGS}, settings => $self->{+SETTINGS}, $cmd ? (command => $cmd) : (), ); } } sub _pre_command_options { $_[0]->{+PRE_LIST} } sub _command_options { my $self = shift; my $class = $self->{+COMMAND_CLASS} or croak "The 'command_class' attribute has not yet been set"; my $cmd = $class->name; my $cmd_options = $self->{+CMD_LIST} // []; my $pre_options = $self->{+PRE_LIST} // []; return [grep { $_->applicable($self) } @$cmd_options, @$pre_options]; } sub _process_opts { my $self = shift; my ($list) = @_; while (my $opt_set = shift @$list) { my ($opt, $meth, @args) = @$opt_set; $opt->$meth(@args, $self->{+SETTINGS}, $self, $list); $self->{+SET_BY_CLI}->{$opt->prefix}->{$opt->field}++; push @{$self->{+USED_PLUGINS}} => $opt->from_plugin if $opt->from_plugin; } } sub _parse_long_option { my $self = shift; my ($arg) = @_; $arg =~ m/^--((?:no-)?([^=]+))(=(.*))?$/ or confess "Invalid long option: $arg"; #return (main, full, val); return ($2, $1, $3 ? $4 // '' : undef); } sub _parse_short_option { my $self = shift; my ($arg) = @_; $arg =~ m/^-([^-])(=)?(.+)?$/ or confess "Invalid short option: $arg"; #return (main, remain, assign); return ($1, $3, $2); } sub _handle_long_option { my $self = shift; my ($arg, $lookup, $args) = @_; my ($main, $full, $val) = $self->_parse_long_option($arg); my $opt; if ($opt = $lookup->{long}->{$full}) { if ($opt->requires_arg) { $val //= shift(@$args) // die "Option --$full requires an argument.\n"; } elsif($opt->allows_arg) { $val //= $opt->autofill // 1; } else { die "Option --$full does not take an argument\n" if defined $val; $val = 1; } return [$opt, 'handle', $val]; } elsif ($opt = $lookup->{long}->{$main}) { die "Option --$full does not take an argument\n" if defined $val; return [$opt, 'handle_negation']; } return undef; } sub _handle_short_option { my $self = shift; my ($arg, $lookup, $args) = @_; my ($main, $remain, $assign) = $self->_parse_short_option($arg); if (my $opt = $lookup->{short}->{$main}) { if ($opt->allows_arg) { my $val = $remain; $val //= '' if $assign; if ($opt->requires_arg) { $val //= shift(@$args) // die "Option -$main requires an argument.\n"; } else { $val //= $opt->autofill // 1; } $val //= 1; return [$opt, 'handle', $val]; } elsif ($assign) { die "Option -$main does not take an argument\n"; } elsif(defined($remain) && length($remain)) { unshift @$args => "-$remain"; } return [$opt, 'handle', 1]; } return undef; } my %ARG_ENDS = ('--' => 1, '::' => 1); sub _grab_opts { my $self = shift; my ($opt_fetch, $type, %config) = @_; croak "The opt_fetch callback is required" unless $opt_fetch; croak "The arg type is required" unless $type; my $args = $config{args} || $self->{+ARGS} or confess "The 'args' attribute has not yet been set"; my $lookup = $self->_build_lookup($self->$opt_fetch()); my (@keep_args, @opts); while (@$args) { my $arg = shift @$args; if ($ARG_ENDS{$arg}) { push @keep_args => $arg; last; } if (substr($arg, 0, 1) eq '-') { my $handler = (substr($arg, 1, 1) eq '-') ? '_handle_long_option' : '_handle_short_option'; if(my $opt_set = $self->$handler($arg, $lookup, $args)) { my ($opt, $action, @val) = @$opt_set; if (my $pre = $opt->pre_process) { $pre->( opt => $opt, options => $self, action => $action, type => $type, @val ? (val => $val[0]) : (), ); } $lookup = $self->_build_lookup($self->$opt_fetch()) if $opt->adds_options; push @opts => $opt_set; next; } elsif (!$config{passthrough}) { my $err = "Invalid $type option: $arg"; my $handled = $self->{+COMMAND_CLASS} && $self->{+COMMAND_CLASS}->handle_invalid_option($type, $arg, $err); die "$err\n" unless $handled; } } if ($config{die_at_non_opt}) { my $err = "Invalid $type option: $arg"; my $handled = $self->{+COMMAND_CLASS} && $self->{+COMMAND_CLASS}->handle_invalid_option($type, $arg, $err); die "$err\n" unless $handled; } push @keep_args => $arg; last if $config{stop_at_non_opt}; } unshift @$args => @keep_args; return @opts; } sub _build_lookup { my $self = shift; my ($opts) = @_; my $lookup = {long => {}, short => {}}; my %seen; for my $opt (@$opts) { next if $seen{$opt}++; for my $long ($opt->long_args) { $lookup->{long}->{$long} //= $opt; } my $short = $opt->short or next; $lookup->{short}->{$short} //= $opt; } return $lookup; } sub _post { my $self = shift; my ($weight, $applicable, $cb) = @_; $self->{+POST_LIST_SORTED} = 0; $weight //= 0; push @{$self->{+POST_LIST} //= []} => [$weight, $applicable, $cb]; } sub _option { my $self = shift; my ($trace, @spec) = @_; my %proto = $self->_parse_option_args(@spec); my $opt = App::Yath::Option->new( trace => $trace, $self->_parse_option_caller($trace->[0], \%proto), %proto, ); $self->include_option($opt); } sub include_option { my $self = shift; my ($opt) = @_; my $trace = $opt->trace or confess "Options must have a trace!"; push @{$self->{+ALL}} => $opt; my $new = $self->_index_option($opt); $self->_list_option($opt) if $new; return $opt; } sub _parse_option_caller { my $self = shift; my ($caller, $proto) = @_; my ($from_plugin, $from_command, $from_prefix, $prefix, $is_top); $prefix = $proto->{prefix} if exists $proto->{prefix}; $prefix //= $caller->option_prefix() if $caller->can('option_prefix'); if ($caller->isa('App::Yath::Command')) { $from_command = $caller->name() unless $caller eq 'App::Yath::Command'; $is_top = 1; } elsif ($caller =~ m/App::Yath::Command::([^:]+)::.*Options(?:::.*)?$/) { $from_command = $1; $is_top = 1; } elsif ($caller eq 'App::Yath') { $is_top = 1; } elsif ($caller =~ m/^(App::Yath::Plugin::([^:]+))$/) { $from_plugin = $1; $from_prefix = $2; unless (defined $prefix) { $prefix = $from_prefix; $prefix =~ s/::.*$//g; } } $prefix = lc($prefix) if $prefix; croak "Could not find an option prefix and option is not top-level ($proto->{title})" unless $is_top || defined($prefix) || defined($proto->{prefix}); return ( $from_plugin ? (from_plugin => $from_plugin) : (), $from_command ? (from_command => $from_command) : (), ($prefix || !$is_top) ? (prefix => $prefix) : (), ); } sub _parse_option_args { my $self = shift; my @spec = @_; my %args; if (@spec == 1) { my ($title, $type) = $spec[0] =~ m/^([\w-]+)(?:=(.+))?$/ or croak "Invalid option specification: $spec[0]"; return (title => $title, type => $type); } elsif (@spec == 2) { my ($title, $type) = @spec; return (title => $title, type => $type); } my $title = shift @spec; return (title => $title, @spec); } sub _index_option { my $self = shift; my ($opt) = @_; my $index = $self->{+LOOKUP}; my $out = 0; for my $n ($opt->name, @{$opt->alt || []}) { if (my $existing = $index->{$n}) { next if "$existing" eq "$opt"; croak "Option '$n' was already defined (" . $existing->trace_string . ")"; } $out++; $index->{$n} = $opt; } if (my $short = $opt->short) { if (my $existing = $index->{$short}) { return $out if "$existing" eq "$opt"; croak "Option '$short' was already defined (" . $existing->trace_string . ")"; } $out++; $index->{$short} = $opt; } return $out; } sub _list_option { my $self = shift; my ($opt) = @_; return push @{$self->{+PRE_LIST}} => $opt if $opt->pre_command; push @{$self->{+CMD_LIST}} => $opt; } sub pre_docs { my $self = shift; return $self->_docs($self->_pre_command_options(), @_); } sub cmd_docs { my $self = shift; return unless $self->{+COMMAND_CLASS}; return $self->_docs([grep { !$_->pre_command } @{$self->_command_options()}], @_); } my %DOC_FORMATS = ( 'cli' => [ 'cli_docs', # Method to call on opt "\n", # how to join lines sub { "\n$_[1]" }, # how to render the category sub { $_[0] =~ s/^/ /mg; "$_[0]\n" }, # transform the value from the opt sub { }, # add this at the end ], 'pod' => [ 'pod_docs', # Method to call on opt "\n\n", # how to join lines sub { ($_[0] ? ("=back") : (), "=head$_[2] $_[1]", "=over 4") }, # how to render the category sub { $_[0] }, # transform the value from the opt sub { $_[0] ? ("=back") : () }, # add this at the end ], ); sub _docs { my $self = shift; my ($opts, $format, @args) = @_; $format //= "UNDEFINED"; my $fset = $DOC_FORMATS{$format} or croak "Invalid documentation format '$format'"; my ($fmeth, $join, $fcat, $ftrans, $fend) = @$fset; return unless $opts; return unless @$opts; my @opts = sort _doc_sort_ops @$opts; my @out; my $cat; for my $opt (@opts) { if (!$cat || $opt->category ne $cat) { push @out => $fcat->($cat, $opt->category, @args); $cat = $opt->category; } my $help = $opt->$fmeth(); push @out => $ftrans->($help); } push @out => $fend->($cat); return join $join => @out; } sub _doc_sort_ops($$) { my ($a, $b) = @_; my $anc = $a->category eq 'NO CATEGORY - FIX ME'; my $bnc = $b->category eq 'NO CATEGORY - FIX ME'; if($anc xor $bnc) { return 1 if $anc; return -1; } my $ret = $a->category cmp $b->category; $ret ||= ($a->prefix || '') cmp ($b->prefix || ''); $ret ||= $a->field cmp $b->field; $ret ||= $a->name cmp $b->name; return $ret; } sub clear_env { my $self = shift; for my $opt (@{$self->{+ALL}}) { next unless $opt->clear_env_vars; my $env = $opt->env_vars or next; for my $var (@$env) { $var =~ s/^!//; delete $ENV{$var}; } } } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options - Tools for defining and tracking yath CLI options. =head1 DESCRIPTION This class represents a collection of options, and holds the logic for processing them. This package also exports sugar to help you define options. =head1 SYNOPSIS package My::Options; use App::Yath::Options; # This package now has a package instance of options, which can be obtained # via the options() method. my $options = __PACKAGE__->options; # We can include options from other packages include_options( 'Package::With::Options::A', 'Package::With::Options::B', ..., ); # Define an option group with some options option_group { %common_fields } => sub { # Define an option option foo => ( type => 's', default => "FOOOOOOO", category => 'foo', description => "This is foo" long_examples => [' value'], ... ); option bar => ( ... ); ... }; # Action to call right after options are parsed. post sub { my %params = @_; ... }; =head1 EXPORTS =over 4 =item $opts = options() =item $opts = $class->options() This returns the options instance associated with your package. =item include_options(@CLASSES) This lets you include options defined in other packages. =item option_group \%COMMON_FIELDS => sub { ... } An option group is simply a block where all calls to C will have common fields added automatically, this makes it easier to define multiple options that share common fields. Common fields can be overridden inside the option definition. These are both equivalent: # Using option group option_group { category => 'foo', prefix => 'foo' } => sub { option a => (type => 'b'); option b => (type => 's'); }; # Not using option group option a => (type => 'b', category => 'foo', prefix => 'foo'); option b => (type => 's', category => 'foo', prefix => 'foo'); =item option TITLE => %FIELDS Define an option. The first argument is the C attribute for the new option, all other arguments should be attribute/value pairs used to construct the option. See L<App::Yath::Option> for the documentation of attributes. =item post sub { ... } =item post $weight => sub { ... } C<post> callbacks are run after all command line arguments have been processed. This is a place to verify the result of several options combined, sanity check, or even add short-circuit behavior. This is how the C<--help> and C<--show-opts> options are implemented. If no C<$weight> is specified then C<0> is used. C<post> callbacks or sorted based on weight with higher values being run later. =back =head1 OPTIONS INSTANCES In general you should not be using the options instance directly. Options instances are mostly an implementation detail that should be treated as a black box. There are however a few valid reasons to interact with them directly. In those cases there are a few public attributes/methods you can work with. This section documents the public interface. =head2 ATTRIBUTES This section only lists attributes that may be useful to people working with options instances. There are a lot of internal (to yath) attributes that are implementation details that are not listed here. Attributes not listed here are not intended for external use and may change at any time. =over 4 =item $arrayref = $options->all Arrayref containing all the L<App::Yath::Option> instances in the options instance. =item $settings = $options->settings Get the L<Test2::Harness::Settings> instance. =item $arrayref = $options->args Get the reference to the list of command line arguments. This list is modified as arguments are processed, there are no guarentees about what is in here at any given stage of argument processing. =item $class_name = $options->command_class If yath has determined what command is being executed this will be populated with that command class. This will be undefined if the class has not been determined yet. =item $arrayref = $options->used_plugins This is a list of all plugins who's options have been used. Plugins may appear more than once. =item $hashref = $options->included A hashref where every key is a package who's options have been included into this options instance. The values are an implementation detail, do not rely on them. =back =head2 METHODS This section only lists methods that may be useful to people working with options instances. There are a lot of internal (to yath) methods that are implementation details that are not listed here. Methods not listed here are not intended for external use and may change at any time. =over 4 =item $opt = $options->option(%OPTION_ATTRIBUTES) This will create a new option with the provided attributes and add it to the options instance. A C<trace> attribute will be automatically set for you. =item $options->include($options_instance) This method lets you directly include options from a second instance into the first. =item $options->include_from(@CLASSES) This lets you include options from multiple classes that have options defined. =item $options->include_option($opt) This lets you include a single already defined option instance. =item $options->pre_docs($format, @args) Get documentation for pre-command options. $format may be 'cli' or 'pod'. =item $options->cmd_docs($format, @args) Get documentation for command options. $format may be 'cli' or 'pod'. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/lib/App/Yath/Command.pm������������������������������������������������������0000644�0001750�0001750�00000022452�15012417054�020405� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Command; use strict; use warnings; our $VERSION = '1.000158'; use File::Spec; use Carp qw/croak/; use Test2::Harness::Util qw/mod2file/; use Test2::Harness::Util::HashBase qw/-settings -args/; use App::Yath::Options(); use Test2::Harness::Util::File::JSON(); sub internal_only { 0 } sub always_keep_dir { 0 } sub summary { "No Summary" } sub description { "No Description" } sub group { "Z-UNFINISHED" } sub doc_args { () } sub only_cmd_opts { 0 } sub handle_invalid_option { 0 } sub munge_opts { } sub name { $_[0] =~ m/([^:=]+)(?:=.*)?$/; $1 || $_[0] } sub run { my $self = shift; warn "This command is currently empty"; return 1; } sub cli_help { my $class = shift; my %params = @_; my $settings = $params{settings} // {}; my $script = $settings->harness->script // $0; my $cmd = $class->name; my (@args) = $class->doc_args; my $options = $params{options}; unless ($options) { $options = App::Yath::Options->new; $options->set_command_class($class); } my ($pre_opts, $cmd_opts); if ($options) { $pre_opts = $options->pre_docs('cli'); $cmd_opts = $options->cmd_docs('cli'); } my $usage = "Usage: $script"; my @out; if ($pre_opts) { $usage .= ' [YATH OPTIONS]'; $pre_opts =~ s/^/ /mg; push @out => "[YATH OPTIONS]\n$pre_opts"; } $usage .= " $cmd"; if ($cmd_opts) { $usage .= " [COMMAND OPTIONS]"; $cmd_opts =~ s/^/ /mg; push @out => "[COMMAND OPTIONS]\n$cmd_opts"; } if (@args) { $usage .= " [COMMAND ARGUMENTS]"; my @desc; for my $arg (@args) { if (ref($arg)) { my ($name, $text) = @$arg; push @desc => $name; $text =~ s/^/ /mg; push @desc => "$text\n"; } else { push @desc => "$arg\n"; } } my $desc = join "\n" => @desc; $desc =~ s/^/ /mg; push @out => "[COMMAND ARGUMENTS]\n$desc"; } chomp(my $desc = $class->description); unshift @out => ("$cmd - " . $class->summary, $desc, $usage); return join("\n\n" => grep { $_ } @out) . "\n"; } sub generate_pod { my $class = shift; my $cmd = $class->name; my (@args) = $class->doc_args; my $options = App::Yath::Options->new(); require App::Yath; my $ay = App::Yath->new(); $options->include($ay->load_options); $options->set_command_class($class); my $pre_opts = $options->pre_docs('pod', 3); my $cmd_opts = $options->cmd_docs('pod', 3); my $usage = " \$ yath [YATH OPTIONS] $cmd"; my @head2s; push @head2s => ("=head2 YATH OPTIONS", $pre_opts) if $pre_opts; if ($cmd_opts) { $usage .= " [COMMAND OPTIONS]"; push @head2s => ("=head2 COMMAND OPTIONS", $cmd_opts); } if (@args) { $usage .= " [COMMAND ARGUMENTS]"; push @head2s => ( "=head2 COMMAND ARGUMENTS", "=over 4", (map { ref($_) ? ( "=item $_->[0]", $_->[1] ) : ("=item $_") } @args), "=back" ); } my @out = ( "=head1 NAME", "$class - " . $class->summary, "=head1 DESCRIPTION", $class->description, "=head1 USAGE", $usage, @head2s ); return join("\n\n" => grep { $_ } @out); } sub write_settings_to { my $self = shift; my ($dir, $file) = @_; croak "'directory' is a required parameter" unless $dir; croak "'filename' is a required parameter" unless $file; my $settings = $self->settings; my $settings_file = Test2::Harness::Util::File::JSON->new(name => File::Spec->catfile($dir, $file)); $settings_file->write($settings); return $settings_file->name; } sub setup_resources { my $self = shift; my $settings = $self->settings; return unless $settings->check_prefix('runner'); my $runner = $settings->runner; my $res = $runner->resources or return; return unless @$res; for my $res (@$res) { require(mod2file($res)) unless ref $res; $res->setup($settings); } } sub setup_plugins { my $self = shift; $_->setup($self->settings) for @{$self->settings->harness->plugins}; } sub teardown_plugins { my $self = shift; my ($renderers, $logger) = @_; $_->teardown($self->settings, $renderers, $logger) for @{$self->settings->harness->plugins}; } sub finalize_plugins { my $self = shift; $_->finalize($self->settings) for @{$self->settings->harness->plugins}; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command - Base class for yath commands =head1 DESCRIPTION This is the base class for any/all yath commands. If you wish to add a new yath command you should subclass this package. =head1 SYNOPSIS package App::Yath::Command::mycommand; use strict; use warnings; use App::Yath::Options(); use parent 'App::Yath::Command'; # Include existing option sets include_options( 'App::Yath::Options::Debug', 'App::Yath::Options::PreCommand', ..., ); # Add some custom options option_group {prefix => 'mycommand', category => 'mycommand options'} => sub { option foo => ( description => "the foo option", default => 0, ); }; # This is used to sort/group commands in the "yath help" output sub group { 'thirdparty' } # Brief 1-line summary sub summary { "This is a third party command, it does stuff..." } # Longer description of the command (used in yath help mycommand) sub description { return <<" EOT"; This command does: This That Those EOT } # Entrypoint sub run { my $self = shift; my $settings = $self->settings; my $args = $self->args; print "Hello Third Party!\n" # Return an exit value. return 0; } =head1 CLASS METHODS =over 4 =item $string = $cmd_class->cli_help(settings => $settings, options => $options) This method generates the command line help for any given command. In general you will NOT want to override this. $settings should be an instance of L<Test2::Harness::Settings>. $options should be an instance of L<App::Yath::Options> if provided. This method is usually capable of filling in the details when this is omitted. =item $multi_line_string = $cmd_class->description() Long-form description of the command. Used in C<cli_help()>. =item @list = $cmd_class->doc_args() A list of argument names to the command, used to generate documentation. =item $string = $cmd_class->generate_pod() This can be used to generate POD documentation from the command itself using the other fields listed in this section, as well as all applicable command lines options specified in the command. =item $string = $cmd_class->group() Used for sorting/grouping commands in the C<yath help> output. Existing groups: ' test' # Space in front to make sure test related command float up 'log' # Log processing commands 'persist' # Commands related to the persistent runner 'zinit' # The init command and related command sink to the bottom. Unless your command OBVIOUSLY and CLEARLY belongs in one of the above groups you should probably create your own. Please do not prefix it with a space to make it float, C<' test'> is a special case, you are not that special. =item $string = $cmd_class->name() Name of the command. By default this is the last part of the package name. You will probably never want to override this. =item $short_string = $cmd_class->summary() A short summary of what this command is. =back =head1 OBJECT METHODS =over 4 =item $bool = $cmd->always_keep_dir() By default the working directory is deleted when yath exits. Some commands such as L<App::Yath::Command::start> need to keep the directory. Override this method to return true if your command uses the workdir and needs to keep it. =item $arrayref = $cmd->args() Get an arrayref of command line arguments B<AFTER> options have been process/removed. =item $bool = $cmd->internal_only() Set this to true if you do not want your command to show up in the help output. =item $exit_code = $cmd->run() This is the main entrypoint for the command. You B<MUST> override this. This method should return an exit code. =item $settings = $cmd->settings() Get the settings as populated by the command line options. =item $cmd->write_settings_to($directory, $filename) A helper method to write the settings to a specified directory and filename. File is written as JSON. If you are subclassing another command such as L<App::Yath::Command::test> you may want to override this to a no-op to prevent the settings file from being written, the L<App::Yath::Command:run> command does this. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/lib/App/Yath/Tester.pm�������������������������������������������������������0000644�0001750�0001750�00000026404�15012417054�020276� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Tester; use strict; use warnings; our $VERSION = '1.000158'; use Test2::API qw/context run_subtest/; use Test2::Tools::Compare qw/is/; use Carp qw/croak/; use File::Spec; use File::Temp qw/tempfile tempdir/; use POSIX; use Fcntl qw/SEEK_CUR/; use App::Yath::Util qw/find_yath/; use Test2::Harness::Util qw/clean_path apply_encoding/; use Test2::Harness::Util::IPC qw/run_cmd/; use Test2::Harness::Util::File::JSONL; use Importer Importer => 'import'; our @EXPORT = qw/yath make_example_dir/; my $pdir = tempdir(CLEANUP => 1); require App::Yath; my $apppath = App::Yath->app_path; sub cover { return unless $ENV{T2_DEVEL_COVER}; $ENV{T2_COVER_SELF} = 1; return '-MDevel::Cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl'; } sub yath { my %params = @_; my $ctx = context(); my $cmd = delete $params{cmd} // delete $params{command}; my $cli = delete $params{cli} // delete $params{args} // []; my $pre = delete $params{pre} // delete $params{pre_command} // []; my $env = delete $params{env} // {}; my $enc = delete $params{encoding}; my $prefix = delete $params{prefix}; my $subtest = delete $params{test} // delete $params{tests} // delete $params{subtest}; my $exittest = delete $params{exit}; my $debug = delete $params{debug} // 0; my $inc = delete $params{inc} // 1; my $capture = delete $params{capture} // 1; my $log = delete $params{log} // 0; my $no_app_path = delete $params{no_app_path}; my $lib = delete $params{lib} // []; if (keys %params) { croak "Unexpected parameters: " . join (', ', sort keys %params); } my (@inc, @dev); if ($inc) { my ($pkg, $file) = caller(); my $dir = $file; $dir =~ s/\.t2?$//g; my $inc = File::Spec->catdir($dir, 'lib'); push @dev => "-D$inc" if -d $inc; } my ($wh, $cfile); if ($capture) { ($wh, $cfile) = tempfile("yath-$$-XXXXXXXX", TMPDIR => 1, UNLINK => 1, SUFFIX => '.out'); $wh->autoflush(1); } my (@log, $logfile); if ($log) { my $fh; ($fh, $logfile) = tempfile("yathlog-$$-XXXXXXXX", TMPDIR => 1, UNLINK => 1, SUFFIX => '.jsonl'); close($fh); @log = ('-F' => $logfile); print "DEBUG: log file = '$logfile'\n" if $debug; } unless ($no_app_path) { push @inc => "-I$apppath" if $cmd =~ m/^(test|start|projects)$/; push @dev => "-D$apppath"; } my @cover = cover(); my $yath = find_yath; my @cmd = ($^X, @$lib, @cover, $yath, @$pre, @dev, $cmd ? ($cmd) : (), @inc, @log, @$cli); print "DEBUG: Command = " . join(' ' => @cmd) . "\n" if $debug; local %ENV = %ENV; $ENV{YATH_PERSISTENCE_DIR} = $pdir; $ENV{YATH_CMD} = $cmd; $ENV{NESTED_YATH} = 1; $ENV{'YATH_SELF_TEST'} = 1; $ENV{$_} = $env->{$_} for keys %$env; my $pid = run_cmd( no_set_pgrp => 1, $capture ? (stderr => $wh, stdout => $wh) : (), command => \@cmd, run_in_parent => [sub { close($wh) }], ); my (@lines, $exit); if ($capture) { open(my $rh, '<', $cfile) or die "Could not open output file: $!"; apply_encoding($rh, $enc) if $enc; $rh->blocking(0); while (1) { seek($rh, 0, SEEK_CUR); # CLEAR EOF my @new = <$rh>; push @lines => @new; print map { chomp($_); "DEBUG: > $_\n" } @new if $debug > 1; waitpid($pid, WNOHANG) or next; $exit = $?; last; } while (my @new = <$rh>) { push @lines => @new; print map { chomp($_); "DEBUG: > $_\n" } @new if $debug > 1; } } else { print "DEBUG: Waiting for $pid\n" if $debug; waitpid($pid, 0); $exit = $?; } print "DEBUG: Exit: $exit\n" if $debug; my $out = { exit => $exit, $capture ? (output => join('', @lines)) : (), $log ? (log => Test2::Harness::Util::File::JSONL->new(name => $logfile)) : (), }; my $name = join(' ', map { length($_) < 30 ? $_ : substr($_, 0, 10) . "[...]" . substr($_, -10) } grep { defined($_) } $prefix, 'yath', @$pre, $cmd ? ($cmd) : (), @$cli); run_subtest( $name, sub { if (defined $exittest) { my $ictx = context(level => 3); is($exit, $exittest, "Exit Value Check"); $ictx->release; } if ($subtest) { local $_ = $out->{output}; local $? = $out->{exit}; $subtest->($out); } my $ictx = context(level => 3); $ictx->diag("Command = " . join(' ' => grep { defined $_ } @cmd) . "\nExit = $exit\n==== Output ====\n$out->{output}\n========") unless $ictx->hub->is_passing; $ictx->release; }, {buffered => 1}, $out, ) if $subtest || defined $exittest; $ctx->release; return $out; } sub _gen_passing_test { my ($dir, $subdir, $file) = @_; my $path = File::Spec->catdir($dir, $subdir); my $full = File::Spec->catfile($path, $file); mkdir($path) or die "Could not make $subdir subdir: $!" unless -d $path; open(my $fh, '>', $full); print $fh "use Test2::Tools::Tiny;\nok(1, 'a passing test');\ndone_testing\n"; close($fh); return $full; } sub make_example_dir { my $dir = tempdir(CLEANUP => 1, TMP => 1); _gen_passing_test($dir, 't', 'test.t'); _gen_passing_test($dir, 't2', 't2_test.t'); _gen_passing_test($dir, 'xt', 'xt_test.t'); return $dir; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Tester - Tools for testing yath =head1 DESCRIPTION This package provides utilities for running yath from within tests to verify its behavior. This is primarily used for integration testing of yath and for third party components. =head1 SYNOPSIS use App::Yath::Tester qw/yath/; my $result = yath( # Command and arguments command => 'test', args => ['-pMyPlugin', 'path/to/test', ...], # Exit code we expect from yath exit => 0, # Subtest to verify results test => sub { my $result = shift; # Redundant since we have the exit check above is($result->{exit}, 0, "Verify exit"); is($result->{output}, $expected_output, "Got the expected output from yath"); }, ); =head1 EXPORTS There are 2 exports from this module. =head2 $result = yath(...) my $result = yath( # Command and arguments command => 'test', args => ['-pMyPlugin', 'path/to/test', ...], # Exit code we expect from yath exit => 0, # Subtest to verify results test => sub { my $result = shift; # Redundant since we have the exit check above is($result->{exit}, 0, "Verify exit"); is($result->{output}, $expected_output, "Got the expected output from yath"); }, ); =head3 ARGUMENTS =over 4 =item cmd => $command =item command => $command Either 'cmd' or 'command' can be used. This argument takes a string that should be a command name. =item cli => \@ARGS =item args => \@ARGS Either 'cli' or 'args' can be used. If none are provided an empty arrayref is used. This argument takes an arrayref of arguments to the yath command. $ yath [PRE_COMMAND] [COMMAND] [ARGS] =item pre => \@ARGS =item pre_command => \@ARGS Either 'pre' or 'pre_command' can be used. An empty arrayref is used if none are provided. These are arguments provided to yath BEFORE the command on the command line. $ yath [PRE_COMMAND] [COMMAND] [ARGS] =item env => \%ENV Provide custom environment variable values to set before running the yath command. =item encoding => $encoding_name If you expect your yath command's output to be in a specific encoding you can specify it here to make sure the C<< $result->{output} >> text has been read properly. =item test => sub { ... } =item tests => sub { ... } =item subtest => sub { ... } These 3 arguments are all aliases for the same thing, only one should be used. The codeblock will be called with C<$result> as the onyl argument. The codeblock will be run as a subtest. If you specify the C<'exit'> argument that check will also happen in the same subtest. test => sub { my $result = shift; ... verify result ... }, =item exit => $integer Verify that the yath command exited with the specified exit code. This check will be run in a subtest. If you specify a custom subtest then this check will appear to come from that subtest. =item debug => $integer Output debug info in realtime, depending on the $integer value this may include the output from the yath command being run. 0 - No debugging 1 - Output the command and other action being taken by the tool 2 - Echo yath output as it happens =item inc => $bool This defaults to true. When true the tool will look for a directory next to your test file with an identical name except that '.t' or '.t2' will be stripped from it. If that directory exists it will be added as a dev-lib to the yath command. If your test file is 't/foo/bar.t' then your yath command will look like this: $ yath -D=t/foo/bar [PRE-COMMAND] [COMMAND] [ARGS] =item capture => $bool Defaults to true. When true the yath output will be captured and put into C<< $result->{output} >>. =item log => $bool Defaults to false. When true yath will be instructed to produce a log, the log will be accessible via C<< $result->{log} >>. C<< $result->{log} >> will be an instance of L<Test2::Harness::Util::File::JSONL>. =item no_app_path => $bool Default to false. Normally C<< -D=/path/to/lib >> is added to the yath command where C<'/path/to/lib'> is the path the the lib dir L<App::Yath> was loaded from. This normally insures the correct version of yath libraries is loaded. When this argument is set to true the path is not added. =item lib => [...] This poorly named argument allows you to inject command line argumentes between C<perl> and C<yath> in the command. perl [LIB] path/to/yath [PRE-COMMAND] [COMMAND] [ARGS] =back =head3 RESULT The result hashref may containt he following fields depending on the arguments passed into C<yath()>. =over 4 =item exit => $integer Exit value returned from yath. =item output => $string The output produced by the yath command. =item log => $jsonl_object An instance of L<Test2::Harness::Util::File::JSONL> opened from the log file produced by the yath command. B<Note:> By default no logging is done, you must specify the C<< log => 1 >> argument to enable it. =back =head2 $path = make_example_dir() This will create a temporary directory with 't', 't2', and 'xt' subdirectories each of which will contain a single passing test. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/lib/App/Yath/Option.pm�������������������������������������������������������0000644�0001750�0001750�00000100126�15012417054�020272� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Option; use strict; use warnings; our $VERSION = '1.000158'; use Carp qw/confess/; use Test2::Harness::Util::HashBase qw{ <title <field <name <type <trace <ignore_for_build <prefix <short <alt <pre_command <from_plugin <from_command <pre_process <adds_options <default <normalize <action <negate <autofill <env_vars <clear_env_vars +applicable <builds <category <description <short_examples <long_examples }; my %TYPES = ( b => 1, c => 1, s => 1, m => 1, d => 1, D => 1, h => 1, H => 1, ); sub valid_type { $TYPES{$_[-1]} } my %LONG_TO_SHORT_TYPES = ( bool => 'b', boolean => 'b', count => 'c', counter => 'c', counting => 'c', scalar => 's', string => 's', number => 's', multi => 'm', multiple => 'm', list => 'm', array => 'm', default => 'd', def => 'd', 'multi-def' => 'D', 'multiple-default' => 'D', 'list-default' => 'D', 'array-default' => 'D', 'hash' => 'h', 'hash-list' => 'H', ); sub canon_type { $LONG_TO_SHORT_TYPES{$_[-1]} } my %REQUIRES_ARG = (s => 1, m => 1, h => 1, H => 1); sub requires_arg { $REQUIRES_ARG{$_[0]->{+TYPE}} } my %ALLOWS_ARG = (d => 1, D => 1); sub allows_arg { $ALLOWS_ARG{$_[0]->{+TYPE}} || $REQUIRES_ARG{$_[0]->{+TYPE} } } sub init { my $self = shift; confess "You must specify 'title' or both 'field' and 'name'" unless $self->{+TITLE} || ($self->{+FIELD} && $self->{+NAME}); confess "The 'prefix' attribute is required" unless $self->{+PREFIX}; confess "The 'alt' attribute must be an array-ref" if $self->{+ALT} && ref($self->{+ALT}) ne 'ARRAY'; if (my $title = $self->{+TITLE}) { $self->{+FIELD} //= $title; $self->{+NAME} //= ($self->{+FROM_PLUGIN} && $self->{+PREFIX}) ? "$self->{+PREFIX}-$title" : $title; } $self->{+FIELD} =~ s/-/_/g; $self->{+NAME} =~ s/_/-/g; if (my $class = $self->{+BUILDS}) { confess "class '$class' does not have a '$self->{+FIELD}' method" unless $class->can($self->{+FIELD}) || $self->{+IGNORE_FOR_BUILD}; } $self->{+TYPE} //= 'b'; $self->{+TYPE} = $self->canon_type($self->{+TYPE}) // $self->{+TYPE} if length($self->{+TYPE}) > 1; confess "Invalid type '$self->{+TYPE}'" unless $self->valid_type($self->{+TYPE}); if ($self->{+TYPE} eq 'd' || $self->{+TYPE} eq 'D') { $self->{+AUTOFILL} //= 1; } elsif(defined $self->{+AUTOFILL}) { confess "'autofill' not supported for this type ('$self->{+TYPE}')"; } if (my $def = $self->{+DEFAULT}) { my $ref = ref($def); confess "'default' must be a simple scalar, or a coderef, got a '$ref'" if $ref && $ref ne 'CODE'; } for my $key (NORMALIZE(), ACTION()) { my $val = $self->{$key} or next; my $ref = ref($val) || 'not a ref'; next if $ref eq 'CODE'; confess "'$key' must be undef, or a coderef, got '$ref'"; } $self->{+TRACE} //= [caller(1)]; $self->{+CATEGORY} //= 'NO CATEGORY - FIX ME'; $self->{+DESCRIPTION} //= 'NO DESCRIPTION - FIX ME'; for my $key (sort keys %$self) { confess "'$key' is not a valid option attribute" unless $self->can(uc($key)); } return $self; } sub applicable { my $self = shift; my ($options) = @_; my $cb = $self->{+APPLICABLE} or return 1; return $self->$cb($options); } sub long_args { my $self = shift; return ($self->{+NAME}, @{$self->{+ALT} || []}); } sub option_slot { my $self = shift; my ($settings) = @_; confess "A settings instance is required" unless $settings; return $settings->define_prefix($self->{+PREFIX})->vivify_field($self->{+FIELD}); } sub get_default { my $self = shift; for my $var (@{$self->{+ENV_VARS} // []}) { my ($neg) = $var =~ s/^(!)//; next unless exists $ENV{$var}; return !$ENV{$var} if $neg; return $ENV{$var}; } if (defined $self->{+DEFAULT}) { my $def = $self->{+DEFAULT}; return $self->$def() if ref($def); return $def; } return 0 if $self->{+TYPE} eq 'c' || $self->{+TYPE} eq 'b'; return [] if $self->{+TYPE} eq 'm' || $self->{+TYPE} eq 'D'; return {} if $self->{+TYPE} eq 'h' || $self->{+TYPE} eq 'H'; return undef; } sub get_normalized { my $self = shift; my ($raw) = @_; return $self->{+NORMALIZE}->($raw) if $self->{+NORMALIZE}; return $raw ? 1 : 0 if $self->{+TYPE} eq 'b'; if (lc($self->{+TYPE}) eq 'h') { my ($key, $val) = split /=/, $raw, 2; if ($self->{+TYPE} eq 'H') { $val //= ''; $val = [split /,/, $val]; return [$key, $val]; } return [$key, $val // 1]; } return $raw; } my %HANDLERS = ( c => sub { ${$_[0]}++ }, m => sub { push @{${$_[0]} //= []} => $_[1] && ref($_[1]) eq 'ARRAY' ? @{$_[1]} : $_[1] }, D => sub { push @{${$_[0]} //= []} => $_[1] && ref($_[1]) eq 'ARRAY' ? @{$_[1]} : $_[1] }, h => sub { my $hash = ${$_[0]} //= {}; my $key = $_[1]->[0]; my $val = $_[1]->[1]; push @{$hash->{'@'} //= []} => $key unless $hash->{$key}; $hash->{$key} = $val; }, H => sub { my $hash = ${$_[0]} //= {}; my $key = $_[1]->[0]; my $vals = $_[1]->[1]; push @{$hash->{'@'} //= []} => $key unless $hash->{$key}; push @{$hash->{$key} //= []} => @$vals; }, ); sub handle { my $self = shift; my ($raw, $settings, $options, $list) = @_; confess "A settings instance is required" unless $settings; confess "An options instance is required" unless $options; my $slot = $self->option_slot($settings); my $norm = $self->get_normalized($raw); my $handler = $HANDLERS{$self->{+TYPE}} //= sub { ${$_[0]} = $_[1] }; return $self->{+ACTION}->($self->{+PREFIX}, $self->{+FIELD}, $raw, $norm, $slot, $settings, $handler, $options) if $self->{+ACTION}; return $handler->($slot, $norm); } sub handle_negation { my $self = shift; my ($settings, $options) = @_; confess "A settings instance is required" unless $settings; confess "An options instance is required" unless $options; my $slot = $self->option_slot($settings); return $self->{+NEGATE}->($self->{+PREFIX}, $self->{+FIELD}, $slot, $settings, $options) if $self->{+NEGATE}; return $$slot = 0 if $self->{+TYPE} eq 'b' || $self->{+TYPE} eq 'c'; return @{$$slot //= []} = () if $self->{+TYPE} eq 'm' || $self->{+TYPE} eq 'D'; return %{$$slot //= {}} = () if $self->{+TYPE} eq 'h' || $self->{+TYPE} eq 'H'; return $$slot = undef; } sub trace_string { my $self = shift; my $trace = $self->{+TRACE} or return "[UNKNOWN]"; return "$trace->[1] line $trace->[2]"; } my %TYPE_LONG_ARGS = ( b => [''], c => [''], s => [' ARG', '=ARG'], m => [' ARG', '=ARG'], d => ['[=ARG]'], D => ['[=ARG]'], h => [' KEY=VAL', '=KEY=VAL'], H => [' KEY=VAL1,VAL2,...', '=KEY=VAL1,VAL2,...'], ); my %TYPE_SHORT_ARGS = ( b => [''], c => [''], s => [' ARG', '=ARG'], m => [' ARG', '=ARG'], d => ['[=ARG]', '[ARG]'], D => ['[=ARG]', '[ARG]'], h => [' KEY=VAL', '=KEY=VAL'], H => [' KEY=VAL1,VAL2,...', '=KEY=VAL1,VAL2,...'], ); my %TYPE_NOTES = ( 'c' => "Can be specified multiple times", 'm' => "Can be specified multiple times", 'D' => "Can be specified multiple times", 'h' => "Can be specified multiple times", 'H' => "Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together.", ); sub cli_docs { my $self = shift; my @forms = (map { "--$self->{+NAME}$_" } @{$self->{+LONG_EXAMPLES} || $TYPE_LONG_ARGS{$self->{+TYPE}}}); for my $alt (@{$self->{+ALT} || []}) { push @forms => (map { "--$alt$_" } @{$self->{+LONG_EXAMPLES} || $TYPE_LONG_ARGS{$self->{+TYPE}}}); } push @forms => map { "-$self->{+SHORT}$_" } @{$self->{+SHORT_EXAMPLES} || $TYPE_SHORT_ARGS{$self->{+TYPE}}} if $self->{+SHORT}; push @forms => "--no-$self->{+NAME}"; my @out; require App::Yath::Util; require Test2::Util::Term; my $width = Test2::Util::Term::term_size() - 20; $width = 80 unless $width && $width >= 80; push @out => App::Yath::Util::fit_to_width($width, ", ", \@forms); my $desc = App::Yath::Util::fit_to_width($width, " ", $self->{+DESCRIPTION}); $desc =~ s/^/ /gm; push @out => $desc; push @out => "\n Can also be set with the following environment variables: " . join(", ", @{$self->{+ENV_VARS}}) if $self->{+ENV_VARS}; push @out => "\n Note: " . $TYPE_NOTES{$self->{+TYPE}} if $TYPE_NOTES{$self->{+TYPE}}; return join "\n" => @out; } sub pod_docs { my $self = shift; my @forms = (map { "--$self->{+NAME}$_" } @{$self->{+LONG_EXAMPLES} || $TYPE_LONG_ARGS{$self->{+TYPE}}}); for my $alt (@{$self->{+ALT} || []}) { push @forms => (map { "--$alt$_" } @{$self->{+LONG_EXAMPLES} || $TYPE_LONG_ARGS{$self->{+TYPE}}}); } push @forms => map { "-$self->{+SHORT}$_" } @{$self->{+SHORT_EXAMPLES} || $TYPE_SHORT_ARGS{$self->{+TYPE}}} if $self->{+SHORT}; push @forms => "--no-$self->{+NAME}"; my @out = map { "=item $_" } @forms; push @out => $self->{+DESCRIPTION}; push @out => "Can also be set with the following environment variables: " . join(", ", map { "C<$_>" } @{$self->{+ENV_VARS}}) if $self->{+ENV_VARS}; push @out => $TYPE_NOTES{$self->{+TYPE}} if $TYPE_NOTES{$self->{+TYPE}}; return join("\n\n" => @out) . "\n"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Option - Representation of a yath option. =head1 DESCRIPTION This class represents a single command line option for yath. =head1 SYNOPSIS You usually will not be creating option instances directly. Usually you will use App::Yath::Options which provides sugar, and helps make sure options get to the right place. use App::Yath::Options; # You can specify a single option: option color => ( prefix => 'display', category => "Display Options", description => "Turn color on, default is true if STDOUT is a TTY.", default => sub { -t STDOUT ? 1 : 0 }, ); # If you are specifying multiple options you can use an option_group to # define common parameters. option_group {prefix => 'display', category => "Display Options"} => sub { option color => ( description => "Turn color on, default is true if STDOUT is a TTY.", default => sub { -t STDOUT ? 1 : 0 }, ); option verbose => ( short => 'v', type => 'c', description => "Be more verbose", default => 0, ); }; =head1 ATTRIBUTES These can be provided at object construction, or are generated internally. =head2 CONSTRUCTION ONLY =over 4 =item applicable => sub { ... } This is callback is used by the C<applicable()> method. option foo => ( ..., applicable => sub { my ($opt, $options) = @_; ... return $bool; }, ); =back =head2 READ-ONLY =head3 REQUIRED =over 4 =item $class->new(prefix => 'my_prefix') =item $scalar = $opt->prefix() A prefix is required. All options have their values inserted into the settings structure, an instance of L<Test2::Harness::Settings>. The structure is C<< $settings->PREFIX->OPTION >>. If you do not specify a C<name> attribute then the default name will be C<PREFIX-TITLE>. The name is the main command line argument, so C<--PREFIX-TITLE> is the default name. =item $class->new(type => $type) =item $type = $opt->type() All options must have a type, if non is specified the default is C<'b'> aka boolean. Here are all the possible types, along with their aliases. You may use the type character, or any of the aliases to specify that type. =over 4 =item b bool boolean True of false values, will be normalized to 0 or 1 in most cases. =item c count counter counting Counter, starts at 0 and then increments every time the option is used. =item s scalar string number Requires an argument which is treated as a scalar value. No type checking is done by the option itself, though you can check it using C<action> or C<normalize> callbacks which are documented under those attributes. =item m multi multiple list array Requires an argument which is treated as a scalar value. Can be used multiple times. All arguments provided are appended to an array. =item d def default Argument is optional, scalar when provided. C<--opt=arg> to provide an argument, C<--opt arg> will not work, C<arg> will be seen as its own item on the command line. Can be specified without an arg C<--opt> to signify a default argument should be used (set via the C<action> callback, not the C<default> attribute which is a default value regardless of if the option is used.) Real world example from the debug options (simplified for doc purposes): option summary => ( type => 'd', description => "Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted.", long_examples => ['', '=/path/to/summary.json'], # New way to specify an auto-fill value for when no =VAL is provided. # If you do not specify this the default autofill is '1' for legacy support. autofill => 'VALUE', # Old way to autofill a value (default is 1 for auto-fill) # Using autofill is significantly better. # You can also use action for additional behavior along with autofill, # but the default will be your auto-fill value, not '1'. action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; # $norm will be '1' if option was used without an argument, so we # just use the provided value when it is not 1'. return $$slot = $norm unless $norm eq '1'; # $norm was 1, so this is our no-arg "default" behavior # Do nothing if a value is already set return if $$slot; # Set the default value of 'summary.json' return $$slot = 'summary.json'; }, ); }; =item D multi-def multiple-default list-default array-default This is a combination of C<d> and C<m>. You can use the opt multiple times to list multiple values, and you can call it without args to add a set of "default" values (not to be confused with THE default attribute, which is used even if the option never appears on the command line.) Real world example (simplified for doc purposes): option dev_libs => ( type => 'D', short => 'D', name => 'dev-lib', category => 'Developer', description => 'Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch.', long_examples => ['', '=lib'], short_examples => ['', '=lib', 'lib'], # New way to specify the auto-fill values. This may be a single scalar, # or an arrayref. autofill => [ 'lib', 'blib/lib', 'blib/arch' ], # Old way to specify the auto-fill values. action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; # If no argument was provided use the 'lib', 'blib/lib', and 'blib/arch' defaults. # If an argument was provided, use it. push @{$$slot} => ($norm eq '1') ? ('lib', 'blib/lib', 'blib/arch') : ($norm); }, ); =item h hash The hash type. Each time the option is used it is to add a single key/value pair to the hash. Use an C<=> sign to split the key and value. The option can be used multiple times. A value is required. yath --opt foo=bar --opt baz=bat =item H hash-list Similar to the 'h' type except the key/value pair expects a comma separated list for the value, and it will be placed under the key as an arrayef. yath --opt foo=a,b,c --opt bar=1,2,3 The yath command obove would produce this structure: { foo => ['a', 'b', 'c'], bar => ['1', '2', '3'], } =back =item $class->new(title => 'my_title') =item $title = $opt->title() You B<MUST> specify either a title, or BOTH a name and field. If you only specify a title it will be used to generate the name and field. If your title is C<'foo-bar_baz'> then your field will be C<'foo_bar_baz'> and your name will be C<'$PREFIX-foo-bar-baz'>. Basically title is used to generate a sane field and/or name if niether are specified. For field all dashes are changed to underscores. The field is used as a key in the settings: C<< $settings->prefix->field >>. For the name all underscores are changed to dashes, if the option is provided by a plugin then C<'prefix-'> is prepended as well. The name is used for the command line argument C<'--name'>. If you do not want/like the name and field generated from a title then you can specify a name or title directly. =item $class->new(name => 'my-name') =item $name = $opt->name() You B<MUST> specify either a title, or BOTH a name and field. If you only specify a title it will be used to generate the name and field. This name is used as your primary command line argument. If your name is C<foo> then your command line argument is C<--foo>. =item $class->new(field => 'my_field') =item $field = $opt->field() You B<MUST> specify either a title, or BOTH a name and field. If you only specify a title it will be used to generate the name and field. The field is used in the settings hash. If your field is C<foo> then your settings path is C<< $setting->prefix->foo >>. =back =head3 OPTIONAL =over 4 =item $class->new(action => sub ...) =item $coderef = $opt->action() option foo => ( ..., action => sub { my ($prefix, $field_name, $raw_value, $normalized_value, $slot_ref, $settings, $handler, $options) = @_; # If no action is specified the following is all that is normally # done. Having an action means this is not done, so if you want the # value stored you must call this or similar. $handler->($slot, $normalized_value); }, ); =over 4 =item $prefix The prefix for the option, specified when the option was defined. =item $field_name The field for the option, specified whent the option was defined. =item $raw_value The value/argument provided at the command line C<--foo bar> would give us C<"bar">. This is BEFORE any processing/normalizing is done. For options that do not take arguments, or where argumentes are optional and none are provided, this will be '1'. =item $normalized_value If a normalize callback was provided this will be the result of putting the $raw_value through the normalize callback. =item $slot_ref This is a scalar reference to the settings slot that holds the option value(s). The default behavior when no action is specified is usually one of these: $$slot_ref = $normalized_value; push @{$$slot_ref} => $normalized_value; However, to save yourself trouble you can use the C<$handler> instead (see below). =item $settings The L<Test2::Harness::Settings> instance. =item $handler A callback that "does the right thing" as far as setting the value in the settings hash. This is what is used when you do not set an action callback. $handler->($slot, $normalized_value); =item $options The L<App::Yath::Options> instance this options belongs to. This is mainly useful if you have an option that may add even more options (such as the C<--plugin> option can do). Note that if you do this you should also set the C<adds_options> attribute to true, if you do not then the options list will not be refreshed and your new options may not show up. =back =item $class->new(adds_options => $bool) =item $bool = $opt->adds_options() If this is true then it means using this option could result in more options being available (example: Loading a plugin). =item $class->new(alt => ['alt1', 'alt2', ...]) =item $arrayref = $opt->alt() Provide alternative names for the option. These are aliases that can be used to achieve the same thing on the command line. This is mainly useful for backcompat if an option is renamed. =item $class->new(builds => 'My::Class') =item $my_class = $opt->builds() If this option is used in the construction of another object (such as the group it belongs to is composed of options that translate 1-to-1 to fields in another object to build) then this can be used to specify that. The ultimate effect is that an exception will be thrown if that class does not have the correct attribute. This is a safety net to catch errors early if field names change, or are missing between this representation and the object being composed. =item $class->new(category => 'My Category') =item $category = $opt->category() This is used to sort/display help and POD documentation for your option. If you do not provide a category it is set to C<'NO CATEGORY - FIX ME'>. The default value makes sure everyone knows that you do not know what you are doing :-). =item $class->new(clear_env_vars => $bool) =item $bool = $opt->clear_env_vars() This option is only useful when paired with the C<env_vars> attribute. Example: option foo => ( ... env_vars => ['foo', 'bar', 'baz'], clear_env_vars => 1, ): In this case you are saying option foo can be set to the value of C<$ENV{foo}>, C<$ENV{bar}>, or C<$ENV{baz}> vars if any are defined. The C<clear_env_vars> tell it to then delete the environment variables after they are used to set the option. This is useful if you want to use the env var to set an option, but do not want any tests to be able to see the env var after it is used to set the option. =item $class->new(default => $scalar) =item $class->new(default => sub { return $default }) =item $scalar_or_coderef = $opt->default() This sets a default value for the field in the settings hash, the default is set before any command line processing is done, so if the option is never used in the command line the default value will be there. Be sure to use the correct default value for your type. A scalar for 's', an arrayref for 'm', etc. Note, for any non-scalar type you want to use a subref to define the value: option foo => ( ... type => 'm', default => sub { [qw/a b c/] }, ); =item $class->new(description => "Fe Fi Fo Fum") =item $multiline_string = $opt->description() Description of your option. This is used in help output and POD. If you do not provide a value the default is C<'NO DESCRIPTION - FIX ME'>. =item $class->new(env_vars => \@LIST) =item $arrayref = $opt->env_vars() If set, this should be an arrayref of environment variable names. If any of the environment variables are defined then the settings will be updated as though the option was provided onthe command line with that value. Example: option foo => ( prefix => 'blah', type => 's', env_vars => ['FOO', 'BAR'], ); Then command line: FOO="xxx" yath test Should be the same as yath test --foo "xxx" You can also ask to have the environment variables cleared after they are checked: option foo => ( prefix => 'blah', type => 's', env_vars => ['FOO', 'BAR'], clear_env_vars => 1, # This tells yath to clear the env vars after they are used. ); If you would like the option set to the opposite of the envarinment variable you can prefix it with a C<'!'> character: option foo =>( ... env_vars => ['!FOO'], ); In this case these are equivelent: FOO=0 yath test yath test --foo=1 Note that this only works when the variable is defined. If C<$ENV{FOO}> is not defined then the variable is not used. =item $class->new(from_command => 'App::Yath::Command::COMMAND') =item $cmd_class = $opt->from_command() If your option was defined for a specific command this will be set. You do not normally set this yourself, the tools in L<App::Yath::Options> usually handle that for you. =item $class->new(from_plugin => 'App::Yath::Plugin::PLUGIN') =item $plugin_class = $opt->from_plugin() If your option was defined for a specific plugin this will be set. You do not normally set this yourself, the tools in L<App::Yath::Options> usually handle that for you. =item $class->new(long_examples => [' foo', '=bar', ...]) =item $arrayref = $opt->long_examples() Used for documentation purposes. If your option takes arguments then you can give examples here. The examples should not include the option itself, so C<--foo bar> would be wrong, you should just do C< bar>. =item $class->new(negate => sub { ... }) =item $coderef = $opt->negate() If you want a custom handler for negation C<--no-OPT> you can provide one here. option foo => ( ... negate => sub { my ($prefix, $field, $slot, $settings, $options) = @_; ... }, ); The variables are the same as those in the C<action> callback. =item $class->new(normalize => sub { ... }) =item $coderef = $opt->normalize() The normalize attribute holds a callback sub that takes the raw value as input and returns the normalized form. option foo => ( ..., normalize => sub { my $raw = shift; ... return $norm; }, ); =item $class->new(pre_command => $bool) =item $bool = $opt->pre_command() Options are either command-specific, or pre-command. Pre-command options are ones yath processes even if it has not determined what comamnd is being used. Good examples are C<--dev-lib> and C<--plugin>. yath --pre-command-opt COMMAND --command-opt Most of the time this should be false, very few options qualify as pre-command. =item $class->new(pre_process => sub { ... }) =item $coderef = $opt->pre_process() This is essentially a BEGIN block for options. This callback is called as soon as the option is parsed from the command line, well before the value is normalized and added to settings. A good use for this is if your option needs to inject additional L<App::Yath::Option> instances into the L<App::Yath::Options> instance. option foo => ( ... pre_process => sub { my %params = @_; my $opt = $params{opt}; my $options = $params{options}; my $action = $params{action}; my $type = $params{type}; my $val = $params{val}; ...; }, ); Explanation of paremeters: =over 4 =item $params{opt} The op instance =item $params{options} The L<App::Yath::Options> instance. =item $params{action} A string, usually either "handle" or "handle_negation" =item $params{type} A string, usually C<"pre-command"> or C<"command ($CLASS)"> where the second has the command package in the parentheses. =item $params{val} The value being set, if any. For options that do not take arguments, or in the case of negation this key may not exist. =back =item $class->new(short => $single_character_string) =item $single_character_string = $opt->short() If you want your option to be usable as a short option (single character, single dash C<-X>) then you can provide the character to use here. If the option does not require an argument then it can be used along with other no-argument short options: C<-xyz> would be equivilent to C<-x -y -z>. There are only so many single-characters available, so options are restricted to picking only 1. B<Please note:> Yath reserves the right to add any single-character short options in the main distribution, if they conflict with third party plugins/commands then the third party must adapt and change its options. As such it is not recommended to use any short options in third party addons. =item $class->new(short_examples => [' foo', ...]) =item $arrayref = $opt->short_examples() Used for documentation purposes. If your option takes arguments then you can give examples here. The examples should not include the option itself, so C<-f bar> would be wrong, you should just do C< bar>. This attribute is not used if you do not provide a C<short> attribute. =item $class->new(trace => [$package, $file, $line]) =item $arrayref = $opt->trace() This is almost always auto-populated for you via C<caller()>. It should be an arrayref with a package, filename and line number. This is used if there is a conflict between parameter names and/or short options. If such a situation arises the file/line number of all conflicting options will be reported so it can be fixed. =back =head1 METHODS =over 4 =item $bool = $opt->allows_arg() True if arguments can be provided to the option (based on type). This does not mean the option MUST accept arguments. 'D' type options can accept arguments, but can also be used without arguments. =item $bool = $opt->applicable($options) If an option provides an applicability callback this will use it to determine if the option is applicable given the L<App::Yath::Options> instance. If no callback was provided then this returns true. =item $character = $opt->canon_type($type_name) Given a long alias for an option type this will return the single-character canonical name. This will return undef for any unknown strings. This will not translate single character names to themselves, so C<< $opt->canon_type('s') >> will return undef while C<< $opt->canon_type('string') >> will return C<'s'>. =item $val = $opt->get_default() This will return the proper default value for the option. If a custom default was provided it will be returned, otherwise the correct generic default for the option type will be used. Here is a snippet showing the defaults for types: # First check env vars and return any values from there ... # Then check for a custom default and use it. ... return 0 if $self->{+TYPE} eq 'c' || $self->{+TYPE} eq 'b'; return [] if $self->{+TYPE} eq 'm' || $self->{+TYPE} eq 'D'; return {} if $self->{+TYPE} eq 'h' || $self->{+TYPE} eq 'H'; # All others get undef return undef; =item $val $opt->get_normalized($raw) This converts a raw value to a normalized one. If a custom C<normalize> attribute was set then it will be used, otherwise it is normalized in accordance to the type. This is where booleans are turned into 0 or 1, hashes are split, hash-lists are split further, etc. =item $opt->handle($raw, $settings, $options, $list) This method handles setting the value in $settings. You should not normally need to call this yourself. =item $opt->handle_negation() This method is used to handle a negated option. You should not normally need to call this yourself. =item @list = $opt->long_args() Returns the name and any aliases. =item $ref = $opt->option_slot($settings) Get the settings->prefix->field reference. This creates the setting field if necessary. =item $bool = $opt->requires_arg() Returns true if this option requires an argument when used. =item $string = $opt->trace_string() return a string like C<"somefile.pm line 42"> based on where the option was defined. =item $bool = $opt->valid_type($character) Check if a single character type is valid. =back =head2 DOCUMENTATION GENERATION =over 4 =item $string = $opt->cli_docs() Get the option documentation in a format that works for the C<yath help COMMAND> command. =item $string = $opt->pod_docs() Get the option documentation in POD format. =item .... .. option details ... =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/lib/App/Yath/Plugin.pm�������������������������������������������������������0000644�0001750�0001750�00000012040�15012417054�020255� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin; use strict; use warnings; our $VERSION = '1.000158'; use parent 'Test2::Harness::Plugin'; # We do not want this defined by default, but it should be documented #sub handle_event {} #sub sort_files {} #sub sort_files_2 {} sub finish {} sub finalize {} 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Plugin - Base class for yath plugins =head1 DESCRIPTION This is a base class for yath plugins. Note this class also subclasses L<Test2::Harness::Plugin>. This class holds the methods specific to yath, which is the UI layer. L<Test2::Harness::Plugin> holds the methods specific to L<Test2::Harness> which is the backend. =head1 SYNOPSIS package App::Yath::Plugin::MyPlugin; use parent 'App::Yath::Plugin'; # ... Define methods 1; Then to use it at the command line: $ yath -pMyPlugin ... =head1 NOTE ON INSTANCE VS CLASS None of the plugin base classes provide a C<new()> method. By default plugins are not instantiated and only the plugin package name is passed around. All methods are then called on the class. If you want your plugin to be instantiated as an object you need only define a C<new()> method. If this method is defined yath will call it and create an instance. The instance created will then be used when calling all the methods. To pass arguments to the constructor you can use C<yath -pYourPlugin=arg1,arg2,arg3...>. Your plugin can also define options using L<App::Yath::Options> which will be dropped into the C<$settings> that get passed around. =head1 METHODS B<Note:> See L<Test2::Harness::Plugin> for additional method you can implement/override =over 4 =item $plugin->handle_event($event, $settings) Called for every single event that yath sees. Note that this method is not defined by default for performance reasons, however it will be called if you define it. =item @sorted = $plugin->sort_files_2(settings => $settings, files => \@unsorted) This gives your plugin a chance to sort the files before they are added to the queue. Other things are done later to re-order the files optimally based on length or category, so this sort is just for initial job numbering, and to define a base order before optimization takes place. All files to sort will be instances of L<Test2::Harness::TestFile>. This method is normally left undefined, but will be called if you define it. If this is present then C<sort_files()> will be ignored. =item @sorted = $plugin->sort_files(@unsorted) B<DEPRECATED> Use C<sort_files_2()> instead. This gives your plugin a chance to sort the files before they are added to the queue. Other things are done later to re-order the files optimally based on length or category, so this sort is just for initial job numbering, and to define a base order before optimization takes place. All files to sort will be instances of L<Test2::Harness::TestFile>. This method is normally left undefined, but will be called if you define it. =item $plugin->finish(%args) This is what arguments are recieved: ( settings => $settings, # The settings final_data => $final_data, # See below pass => $pass ? 1 : 0, # Always a 0 or 1 tests_seen => $self->{+TESTS_SEEN} // 0, # Integer 0 or greater asserts_seen => $self->{+ASSERTS_SEEN} // 0, # Integer 0 or greater ) The final_data looks like this, note that some data may not be present if it is not applicable. The data structure can be as simple as C<< { pass => $bool } >>. { pass => $pass, # boolean, did the test run pass or fail? failed => [ # Jobs that failed, and did not pass on a retry [$job_id1, $file1], # Failing job 1 [$job_id2, $file2], # Failing job 2 ... ], retried => [ # Jobs that failed and were retried [$job_id1, $times_run1, $file1, $passed_eventually1], # Passed_eventually is a boolean [$job_id2, $times_run2, $file2, $passed_eventually2], ... ], hatled => [ # Jobs that caused the entire test suite to halt [$job_id1, $file1, $halt_reason1], # halt_reason is a human readible string [$job_id2, $file2, $halt_reason2], ], } =item $plugin->finalize($settings) This is called as late as possible before exit. This is mainly useful for outputting messages such as "Extra log file written to ..." which are best put at the end of output. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/lib/App/Yath/Util.pm���������������������������������������������������������0000644�0001750�0001750�00000023310�15012417054�017736� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Util; use strict; use warnings; our $VERSION = '1.000158'; use File::Spec; use Sys::Hostname qw/hostname/; use Test2::Harness::Util qw/clean_path/; use Test2::Harness::Util::File::JSON; use Cwd qw/realpath/; use Importer Importer => 'import'; use Config qw/%Config/; use Carp qw/croak/; our @EXPORT_OK = qw{ find_pfile find_in_updir is_generated_test_pl fit_to_width isolate_stdout find_yath }; sub find_yath { return $App::Yath::Script::SCRIPT if defined $App::Yath::Script::SCRIPT; if (-d 'scripts') { my $script = File::Spec->catfile('scripts', 'yath'); return $App::Yath::Script::SCRIPT = clean_path($script) if -e $script && -x $script; } my @keys = qw{ bin binexp initialinstalllocation installbin installscript installsitebin installsitescript installusrbinperl installvendorbin scriptdir scriptdirexp sitebin sitebinexp sitescript sitescriptexp vendorbin vendorbinexp }; my %seen; for my $path (@Config{@keys}) { next unless $path; next if $seen{$path}++; my $script = File::Spec->catfile($path, 'yath'); next unless -f $script && -x $script; $App::Yath::Script::SCRIPT = $script = clean_path($script); return $script; } die "Could not find yath in Config paths"; } sub isolate_stdout { # Make $fh point at STDOUT, it is our primary output open(my $fh, '>&', STDOUT) or die "Could not clone STDOUT: $!"; select $fh; $| = 1; # re-open STDOUT redirected to STDERR open(STDOUT, '>&', STDERR) or die "Could not redirect STDOUT to STDERR: $!"; select STDOUT; $| = 1; # Yes, we want to keep STDERR selected select STDERR; $| = 1; return $fh; } sub is_generated_test_pl { my ($file) = @_; open(my $fh, '<', $file) or die "Could not open '$file': $!"; my $count = 0; while (my $line = <$fh>) { last if $count++ > 5; next unless $line =~ m/^# THIS IS A GENERATED YATH RUNNER TEST$/; return 1; } return 0; } sub find_in_updir { my $path = shift; return clean_path($path) if -f $path; my %seen; while(1) { $path = File::Spec->catdir('..', $path); my $check = eval { realpath(File::Spec->rel2abs($path)) }; last unless $check; last if $seen{$check}++; return $check if -f $check; } return; } sub _find_pfile { my ($settings, %params) = @_; croak "Settings is a required argument" unless $settings; # First do the entire search without vivify if ($params{vivify}) { my $found = find_pfile($settings, %params, vivify => 0); return $found if $found; } my $yath = $settings->harness; if (my $pfile = $yath->persist_file) { return $pfile if -f $pfile || $params{vivify}; return; # Specified, but not found and no vivify } my $basename = "yath-persist.json"; my $user = $ENV{USER}; my $hostname = hostname(); my $project = $yath->project; my @names = ($basename); @names = (@names, map { "$project-$_" } @names) if $project; @names = (@names, map { "$hostname-$_" } @names) if $hostname; @names = (@names, map { "$user-$_" } @names) if $user; @names = reverse map { ".$_" } @names; my $set_dir = $yath->persist_dir // $ENV{YATH_PERSISTENCE_DIR}; my $dir = $set_dir // $ENV{TMPDIR} // $ENV{TEMPDIR} // File::Spec->tmpdir; # If a dir was specified, or if the current dir is not writable then we must use $dir/$name if ($project || $set_dir || !-w '.') { for my $name (@names) { my $pfile = clean_path(File::Spec->catfile($dir, $name)); return $pfile if -f $pfile; } return clean_path(File::Spec->catfile($dir, $names[0])) if $params{vivify}; return; # Not found } # Fall back to using the current dir (which must be writable) for my $name (@names) { my $pfile = find_in_updir($name); return $pfile if $pfile && -f $pfile; } # Creating it here! return clean_path(File::Spec->catfile('.', $names[0])) if $params{vivify}; # Nope, nothing. return; } sub fit_to_width { my ($width, $join, $text) = @_; my @parts = ref($text) ? @$text : split /\s+/, $text; my @out; my $line = ""; for my $part (@parts) { my $new = $line ? "$line$join$part" : $part; if ($line && length($new) > $width) { push @out => $line; $line = $part; } else { $line = $new; } } push @out => $line if $line; return join "\n" => @out; } my $SEEN_ERROR = 0; sub find_pfile { my ($settings, %params) = @_; my $pfile = _find_pfile($settings, %params) or return; return $pfile unless -e $pfile; return $pfile if $params{no_checks}; return $pfile if $SEEN_ERROR; my $data = Test2::Harness::Util::File::JSON->new(name => $pfile)->read(); $data->{version} //= ''; $data->{hostname} //= ''; $data->{user} //= ''; $data->{pid} //= ''; $data->{dir} //= ''; my $hostname = hostname(); my $user = $ENV{USER}; my @bad; push @bad => "** Version mismatch, persistent runner is version $data->{version}, current is version $VERSION. **" if $data->{version} ne $VERSION; push @bad => "** Hostname mismatch, persistent runner hostname is '$data->{hostname}', current hostname is '$hostname'. **" if $data->{hostname} ne $hostname; push @bad => "** User mismatch, persistent runner user is '$data->{user}', current user is '$user'. **" if $data->{user} ne $user; push @bad => "** Workdir missing, persistent runner is supposed to be at '$data->{dir}', but it does not exist. **" unless -d $data->{dir}; push @bad => "** PID not running, persistent runner is supposed to be running with PID '$data->{pid}', but it is not. **" unless kill(0, $data->{pid}); return $pfile unless @bad; my $break = ('=' x 120) . "\n"; my $msg = join "\n" => $break, @bad, <<" EOT", $break; Errors like this usually indicate that the persistent runner has gone away. Maybe the system was shut down improperly, or maybe the process was killed too quickly to clean up after itself. Here is the information indicated by the persistence file: Runner PID: $data->{pid} Runner Vers: $data->{version} Runner user: $data->{user} Runner host: $data->{hostname} Working dir: $data->{dir} If the persistent runner is truly gone you should delete the following file to continue: $pfile EOT $SEEN_ERROR = 1; die $msg unless $params{no_fatal}; warn $msg unless $params{no_warn}; return $pfile; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Util - General utilities for yath that do not fit anywhere else. =head1 DESCRIPTION This package exports several tools used throughout yath that did not fit into any other package. =head1 SYNOPSIS use App::Yath::Util qw{ find_pfile find_in_updir is_generated_test_pl fit_to_width isolate_stdout find_yath }; =head1 EXPORTS Note that nothing is exported by default, you must request each function to import. =over 4 =item $path_to_pfile = find_pfile($settings, %params) The first argument must be an instance of L<Test2::Harness::Settings>. Currently the only supported param is C<vivify>, when set to true the pfile will be created if one does not already exist. The pfile is a file that tells yath that a persistent runner is active, and how to communicate with it. =item $path_to_file = find_in_updir($file_name) Look for C<$file_name> in the current directory or any parent directory. =item $bool = is_generated_test_pl($path_to_test_file) Check if the specified test file was generated by the C<yath init> command. =item fit_to_width($width, $join, $text) This will split the C<$text> on space, and then recombine it using C<$join> inserting newlines as necessary in an attempt to fit the text into C<$width> horizontal characters. If any words are larger than C<$width> they will not be split and text-wrapping may occur if used for terminal display. =item $stdout = isolate_stdout() This will close STDOUT and reopen it to point at STDERR. The result of this is that any print statement that does not specify a fielhandle will print to STDERR instead of STDOUT, in addition any print directly to STDOUT will instead go to STDERR. A filehandle to the real STDOUT is returned for you to use when you actually want to write to STDOUT. This is used by some yath processes that need to print structured data to STDOUT without letting any third part modules they may load write to the real STDOUT. =item $path_to_script = find_yath() This will attempt to find the C<yath> command line script. When possible this will return the path that was used to launch yath. If yath was not run to start the process it will search the paths specified in the L<Config> module. This will throw an exception if the script cannot be found. Note: The result is cached so that subsequent calls will return the same path even if something installs a new yath script in another location that would otherwise be found first. This guarentees that a single process will not switch scripts. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/lib/App/Yath.pm��������������������������������������������������������������0000644�0001750�0001750�00000060242�15012417054�017026� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package App::Yath; use strict; use warnings; our $VERSION = '1.000158'; use Test2::Harness::Util::HashBase qw{ -config -settings -_options -options_loaded -_argv -argv_processed <_orig_argv -_command_class -_command_name -_early_command }; use Time::HiRes qw/time/; use App::Yath::Util qw/find_pfile/; use Test2::Harness::Util qw/find_libraries clean_path/; use App::Yath::Options(); use Scalar::Util qw/blessed/; my $APP_PATH = __FILE__; $APP_PATH =~ s{App\S+Yath\.pm$}{}g; $APP_PATH = clean_path($APP_PATH); sub app_path { $APP_PATH } sub init { my $self = shift; my $old = select STDOUT; $| = 1; select STDERR; $| = 1; select $old; my @caller = caller(1); $self->{+SETTINGS} //= Test2::Harness::Settings->new; ${$self->{+SETTINGS}->define_prefix('harness')->vivify_field('script')} //= clean_path($caller[1]); ${$self->{+SETTINGS}->define_prefix('harness')->vivify_field('start')} //= time(); ${$self->{+SETTINGS}->define_prefix('harness')->vivify_field('no_scan_plugins')} //= 0; $self->{+_ARGV} //= delete($self->{argv}) // []; $self->{+_ORIG_ARGV} = [@{$self->{+_ARGV}}]; $self->{+CONFIG} //= {}; } sub generate_run_sub { my $self = shift; my ($symbol) = @_; my $cmd_class; my ($options, $argv); if (my $cmd = $self->_command_from_argv(no_default => 1, valid_only => 1)) { $cmd_class = $self->load_command($cmd); $self->{+_COMMAND_NAME} = $cmd; $self->{+_COMMAND_CLASS} = $cmd_class; if ($cmd_class->only_cmd_opts) { $self->{+_EARLY_COMMAND} = 1; my $settings = $self->{+SETTINGS}; $options = App::Yath::Options->new(settings => $settings); $options->set_command_class($cmd_class); $options->set_args($self->{+_ARGV}); $argv = $self->{+_ARGV}; $cmd_class->munge_opts($options, $argv, $settings); } } $options //= $self->load_options(); $cmd_class //= $self->command_class(); ${$self->{+SETTINGS}->define_prefix('harness')->vivify_field('command')} //= $cmd_class; $argv = $self->process_argv(); return $cmd_class->generate_run_sub($symbol, $argv, $self->{+SETTINGS}, $self->{+_ORIG_ARGV}) if $cmd_class->can('generate_run_sub'); my $cmd = $cmd_class->new(settings => $options->settings, args => $argv, orig_args => $self->{+_ORIG_ARGV}); $options->process_option_post_actions($cmd); my $run = sub { $self->run_command($cmd) }; { no strict 'refs'; *{$symbol} = $run; } return; } sub run_command { my $self = shift; my ($cmd) = @_; my $exit = $cmd->run; die "Command '" . $cmd->name() . "' did not return an exit value.\n" unless defined $exit; return $exit; } sub load_options { my $self = shift; my $settings = $self->{+SETTINGS} = $self->{+SETTINGS}; my $options = $self->{+_OPTIONS} //= App::Yath::Options->new(settings => $settings); return $options if $self->{+OPTIONS_LOADED}++; $options->include_from( 'App::Yath::Options::Debug', 'App::Yath::Options::PreCommand', ); return $options if $self->{+SETTINGS}->harness->no_scan_plugins; my $option_libs = { %{find_libraries('App::Yath::Plugin::*')}, %{find_libraries('Test2::Harness::Runner::Resource::*')}, }; for my $lib (sort keys %$option_libs) { my $ok = eval { require $option_libs->{$lib}; 1 }; unless ($ok) { warn "Failed to load module '$option_libs->{$lib}': $@"; next; } next unless $lib->can('options'); my $add = $lib->options; next unless $add; unless (blessed($add) && $add->isa('App::Yath::Options')) { warn "Module '$option_libs->{$lib}' is outdated, not loading options.\n" unless $ENV{'YATH_SELF_TEST'}; next; } $options->include_from($lib); } return $options; } sub process_argv { my $self = shift; return $self->{+_ARGV} if $self->{+ARGV_PROCESSED}++; my $options = $self->load_options(); my $settings = $self->settings; my $config_pre_args = $self->{+CONFIG}->{'~'}; $options->grab_pre_command_opts(args => $config_pre_args, stop_at_non_opt => 0, passthrough => 0, die_at_non_opt => 1) if $config_pre_args; $options->set_args($self->{+_ARGV}); $options->grab_pre_command_opts(); $options->process_pre_command_opts(); my $cmd_name = $self->_command_from_argv(); my $cmd_class = $self->load_command($cmd_name); die "Command '$cmd_name' needs to be specified earlier in the command line arguments to yath.\n" if $cmd_class->only_cmd_opts && !$self->{+_EARLY_COMMAND}; $options->set_command_class($cmd_class); $self->{+_COMMAND_CLASS} = $cmd_class; $options->grab_pre_command_opts(stop_at_non_opt => 1, passthrough => 1, die_at_non_opt => 0); my $config_cmd_args = $self->{+CONFIG}->{$cmd_name}; $options->grab_pre_command_opts(args => $config_cmd_args, stop_at_non_opt => 1, passthrough => 1, die_at_non_opt => 0) if $config_cmd_args; $options->process_pre_command_opts(); $options->grab_command_opts(args => $config_cmd_args, die_at_non_opt => 1, stop_at_non_opt => 0, passthrough => 0) if $config_cmd_args; $options->grab_command_opts(); $options->process_command_opts(); $options->clear_env(); $self->clear_env(); my %seen = map {((ref($_) || $_) => 1)} @{$settings->harness->plugins}; for my $plugin (@{$options->used_plugins}) { next if $seen{$plugin}++; push @{$settings->harness->plugins} => $plugin->can('new') ? $plugin->new() : $plugin; } return $self->{+_ARGV}; } sub clear_env { delete $ENV{HARNESS_IS_VERBOSE}; delete $ENV{T2_FORMATTER}; delete $ENV{T2_HARNESS_FORKED}; delete $ENV{T2_HARNESS_IS_VERBOSE}; delete $ENV{T2_HARNESS_JOB_IS_TRY}; delete $ENV{T2_HARNESS_JOB_NAME}; delete $ENV{T2_HARNESS_PRELOAD}; delete $ENV{T2_STREAM_DIR}; delete $ENV{T2_STREAM_FILE}; delete $ENV{T2_STREAM_JOB_ID}; delete $ENV{TEST2_JOB_DIR}; delete $ENV{TEST2_RUN_DIR}; # If Test2::API is already loaded then we need to keep these. delete $ENV{TEST2_ACTIVE} unless $INC{'Test2/API.pm'}; delete $ENV{TEST_ACTIVE} unless $INC{'Test2/API.pm'}; } sub command_class { my $self = shift; $self->process_argv() unless $self->{+_COMMAND_CLASS}; return $self->{+_COMMAND_CLASS}; } sub _command_from_argv { my $self = shift; my %params = @_; return $self->{+_COMMAND_NAME} if $self->{+_COMMAND_NAME}; my $argv = $self->{+_ARGV}; for (my $idx = 0; $idx < @$argv; $idx++) { my $arg = $argv->[$idx]; if ($arg =~ m/^-*h(elp)?$/i) { splice(@$argv, $idx, 1); return 'help'; } if ($arg eq 'do') { splice(@$argv, $idx, 1); last; } last if $arg eq '::'; next if $arg =~ /^-/; if ($arg =~ m/\.jsonl(\.bz2|\.gz)?$/) { warn "\n** First argument is a log file, defaulting to the 'replay' command **\n\n"; return 'replay'; } return splice(@$argv, $idx, 1) if $self->load_command($arg, check_only => 1); return if $params{valid_only}; my $is_path = 0; $is_path ||= -f $arg; $is_path ||= -d $arg; # Assume it is a command, but an invalid one. return splice(@$argv, $idx, 1) unless $is_path; } return if $params{no_default}; if (my $pfile = find_pfile($self->settings, no_checks => 1)) { warn "\n** Persistent runner detected, defaulting to the 'run' command **\n\n"; return 'run'; } warn "\n** Defaulting to the 'test' command **\n\n"; return 'test'; } sub load_command { my $self = shift; my ($cmd_name, %params) = @_; my $cmd_class = "App::Yath::Command::$cmd_name"; my $cmd_file = "App/Yath/Command/$cmd_name.pm"; return $cmd_class if eval { require $cmd_file; 1 }; my $error = $@ || 'unknown error'; my $not_found = $error =~ m{Can't locate \Q$cmd_file\E in \@INC}; return undef if $params{check_only} && $not_found; die "yath command '$cmd_name' not found. (did you forget to install $cmd_class?)\n" if $not_found; die $error; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath - Yet Another Test Harness (Test2-Harness) Command Line Interface (CLI) =head1 DESCRIPTION This is the primary documentation for C<yath>, L<App::Yath>, L<Test2::Harness>. The canonical source of up-to-date command options are the help output when using C<$ yath help> and C<$ yath help COMMAND>. This document is mainly an overview of C<yath> usage and common recipes. L<App::Yath> is an alternative to L<App::Prove>, and L<Test2::Harness> is an alternative to L<Test::Harness>. It is not designed to replace L<Test::Harness>/prove. L<Test2::Harness> is designed to take full advantage of the rich data L<Test2> can provide. L<Test2::Harness> is also able to use non-core modules and provide more functionality than prove can achieve with its restrictions. =head1 PLATFORM SUPPORT L<Test2::Harness>/L<App::Yath> is is focused on unix-like platforms. Most development happens on linux, but bsd, macos, etc should work fine as well. Patches are welcome for any/all platforms, but the primary author (Chad 'Exodist' Granum) does not directly develop against non-unix platforms. =head2 WINDOWS Currently windows is not supported, and it is known that the package will not install on windows. Patches are be welcome, and it would be great if someone wanted to take on the windows-support role, but it is not a primary goal for the project. =head1 OVERVIEW To use L<Test2::Harness>, you use the C<yath> command. Yath will find the tests (or use the ones you specify) and run them. As it runs, it will output diagnostic information such as failures. At the end, yath will print a summary of the test run. C<yath> can be thought of as a more powerful alternative to C<prove> (L<Test::Harness>) =head1 RECIPES These are common recipes for using C<yath>. =head2 RUN PROJECT TESTS $ yath Simply running yath with no arguments means "Run all tests for the current project". Yath will look for tests in C<./t>, C<./t2>, and C<./test.pl> and run any which are found. Normally this implies the C<test> command but will instead imply the C<run> command if a persistent test runner is detected. =head2 PRELOAD MODULES Yath has the ability to preload modules. Yath normally forks to start new tests, so preloading can reduce the time spent loading modules over and over in each test. Note that some tests may depend on certain modules not being loaded. In these cases you can add the C<# HARNESS-NO-PRELOAD> directive to the top of the test files that cannot use preload. =head3 SIMPLE PRELOAD Any module can be preloaded: $ yath -PMoose You can preload as many modules as you want: $ yath -PList::Util -PScalar::Util =head3 COMPLEX PRELOAD If your preload is a subclass of L<Test2::Harness::Runner::Preload> then more complex preload behavior is possible. See those docs for more info. =head2 LOGGING =head3 RECORDING A LOG You can turn on logging with a flag. The filename of the log will be printed at the end. $ yath -L ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl The event log can be quite large. It can be compressed with bzip2. $ yath -B ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 gzip compression is also supported. $ yath -G ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.gz C<-B> and C<-G> both imply C<-L>. =head3 REPLAYING FROM A LOG You can replay a test run from a log file: $ yath test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 This will be significantly faster than the initial run as no tests are actually being executed. All events are simply read from the log, and processed by the harness. You can change display options and limit rendering/processing to specific test jobs from the run: $ yath test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 -v [TEST UUID(S)] Note: This is done using the C<$ yath replay ...> command. The C<replay> command is implied if the first argument is a log file. =head2 PER-TEST TIMING DATA The C<-T> option will cause each test file to report how long it took to run. $ yath -T ( PASSED ) job 1 t/yath_script.t ( TIME ) job 1 Startup: 0.07692s | Events: 0.01170s | Cleanup: 0.00190s | Total: 0.09052s =head2 PERSISTENT RUNNER yath supports starting a yath session that waits for tests to run. This is very useful when combined with preload. =head3 STARTING This starts the server. Many options available to the 'test' command will work here but not all. See C<$ yath help start> for more info. $ yath start =head3 RUNNING This will run tests using the persistent runner. By default, it will search for tests just like the 'test' command. Many options available to the C<test> command will work for this as well. See C<$ yath help run> for more details. $ yath run =head3 STOPPING Stopping a persistent runner is easy. $ yath stop =head3 INFORMATIONAL The C<which> command will tell you which persistent runner will be used. Yath searches for the persistent runner in the current directory, then searches in parent directories until it either hits the root directory, or finds the persistent runner tracking file. $ yath which The C<watch> command will tail the runner's log files. $ yath watch =head3 PRELOAD + PERSISTENT RUNNER You can use preloads with the C<yath start> command. In this case, yath will track all the modules pulled in during preload. If any of them change, the server will reload itself to bring in the changes. Further, modified modules will be blacklisted so that they are not preloaded on subsequent reloads. This behavior is useful if you are actively working on a module that is normally preloaded. =head2 MAKING YOUR PROJECT ALWAYS USE YATH $ yath init The above command will create C<test.pl>. C<test.pl> is automatically run by most build utils, in which case only the exit value matters. The generated C<test.pl> will run C<yath> and execute all tests in the C<./t> and/or C<./t2> directories. Tests in C<./t> will ALSO be run by prove but tests in C<./t2> will only be run by yath. =head2 PROJECT-SPECIFIC YATH CONFIG You can write a C<.yath.rc> file. The file format is very simple. Create a C<[COMMAND]> section to start the configuration for a command and then provide any options normally allowed by it. When C<yath> is run inside your project, it will use the config specified in the rc file, unless overridden by command line options. B<Note:> You can also add pre-command options by placing them at the top of your config file I<BEFORE> any C<[cmd]> markers. Comments start with a semi-colon. Example .yath.rc: -pFoo ; Load the 'foo' plugin before dealing with commands. [test] -B ;Always write a bzip2-compressed log [start] -PMoose ;Always preload Moose with a persistent runner This file is normally committed into the project's repo. =head3 SPECIAL PATH PSEUDO-FUNCTIONS Sometimes you want to specify files relative to the .yath.rc so that the config option works from any subdirectory of the project. Other times you may wish to use a shell expansion. Sometimes you want both! =over 4 =item rel(path/to/file) -I rel(path/to/extra_lib) -I=rel(path/to/extra_lib) This will take the path to C<.yath.rc> and prefix it to the path inside C<rel(...)>. If for example you have C</project/.yath.rc> then the path would become C</project/path/to/extra_lib>. =item glob(path/*/file) --default-search glob(subprojects/*/t) --default-search=glob(subprojects/*/t) This will add a C<--default-search $_> for every item found in the glob. This uses the perl builtin function C<glob()> under the hood. =item relglob(path/*/file) --default-search relglob(subprojects/*/t) --default-search=relglob(subprojects/*/t) Same as C<glob()> except paths are relative to the C<.yath.rc> file. =back =head2 PROJECT-SPECIFIC YATH CONFIG USER OVERRIDES You can add a C<.yath.user.rc> file. Format is the same as the regular C<.yath.rc> file. This file will be read in addition to the regular config file. Directives in this file will come AFTER the directives in the primary config so it may be used to override config. This file should not normally be committed to the project repo. =head2 HARNESS DIRECTIVES INSIDE TESTS C<yath> will recognise a number of directive comments placed near the top of test files. These directives should be placed after the C<#!> line but before any real code. Real code is defined as any line that does not start with use, require, BEGIN, package, or # =over 4 =item good example 1 #!/usr/bin/perl # HARNESS-NO-FORK ... =item good example 2 #!/usr/bin/perl use strict; use warnings; # HARNESS-NO-FORK ... =item bad example 1 #!/usr/bin/perl # blah # HARNESS-NO-FORK ... =item bad example 2 #!/usr/bin/perl print "hi\n"; # HARNESS-NO-FORK ... =back =head3 HARNESS-NO-PRELOAD #!/usr/bin/perl # HARNESS-NO-PRELOAD Use this if your test will fail when modules are preloaded. This will tell yath to start a new perl process to run the script instead of forking with preloaded modules. Currently this implies HARNESS-NO-FORK, but that may not always be the case. =head3 HARNESS-NO-FORK #!/usr/bin/perl # HARNESS-NO-FORK Use this if your test file cannot run in a forked process, but instead must be run directly with a new perl process. This implies HARNESS-NO-PRELOAD. =head3 HARNESS-NO-STREAM C<yath> usually uses the L<Test2::Formatter::Stream> formatter instead of TAP. Some tests depend on using a TAP formatter. This option will make C<yath> use L<Test2::Formatter::TAP> or L<Test::Builder::Formatter>. =head3 HARNESS-NO-IO-EVENTS C<yath> can be configured to use the L<Test2::Plugin::IOEvents> plugin. This plugin replaces STDERR and STDOUT in your test with tied handles that fire off proper L<Test2::Event>'s when they are printed to. Most of the time this is not an issue, but any fancy tests or modules which do anything with STDERR or STDOUT other than print may have really messy errors. B<Note:> This plugin is disabled by default, so you only need this directive if you enable it globally but need to turn it back off for select tests. =head3 HARNESS-NO-TIMEOUT C<yath> will usually kill a test if no events occur within a timeout (default 60 seconds). You can add this directive to tests that are expected to trip the timeout, but should be allowed to continue. NOTE: you usually are doing the wrong thing if you need to set this. See: C<HARNESS-TIMEOUT-EVENT>. =head3 HARNESS-TIMEOUT-EVENT 60 C<yath> can be told to alter the default event timeout from 60 seconds to another value. This is the recommended alternative to HARNESS-NO-TIMEOUT =head3 HARNESS-TIMEOUT-POSTEXIT 15 C<yath> can be told to alter the default POSTEXIT timeout from 15 seconds to another value. Sometimes a test will fork producing output in the child while the parent is allowed to exit. In these cases we cannot rely on the original process exit to tell us when a test is complete. In cases where we have an exit, and partial output (assertions with no final plan, or a plan that has not been completed) we wait for a timeout period to see if any additional events come into =head3 HARNESS-DURATION-LONG This lets you tell C<yath> that the test file is long-running. This is primarily used when concurrency is turned on in order to run longer tests earlier, and concurrently with shorter ones. There is also a C<yath> option to skip all long tests. This duration is set automatically if HARNESS-NO-TIMEOUT is set. =head3 HARNESS-DURATION-MEDIUM This lets you tell C<yath> that the test is medium. This is the default duration. =head3 HARNESS-DURATION-SHORT This lets you tell C<yath> That the test is short. =head3 HARNESS-CATEGORY-ISOLATION This lets you tell C<yath> that the test cannot be run concurrently with other tests. Yath will hold off and run these tests one at a time after all other tests. =head3 HARNESS-CATEGORY-IMMISCIBLE This lets you tell C<yath> that the test cannot be run concurrently with other tests of this class. This is helpful when you have multiple tests which would otherwise have to be run sequentially at the end of the run. Yath prioritizes running these tests above HARNESS-CATEGORY-LONG. =head3 HARNESS-CATEGORY-GENERAL This is the default category. =head3 HARNESS-CONFLICTS-XXX This lets you tell C<yath> that no other test of type XXX can be run at the same time as this one. You are able to set multiple conflict types and C<yath> will honor them. XXX can be replaced with any type of your choosing. NOTE: This directive does not alter the category of your test. You are free to mark the test with LONG or MEDIUM in addition to this marker. =head3 HARNESS-JOB-SLOTS 2 =head3 HARNESS-JOB-SLOTS 1 10 Specify a range of job slots needed for the test to run. If set to a single value then the test will only run if it can have the specified number of slots. If given a range the test will require at least the lower number of slots, and use up to the maximum number of slots. =over 4 =item Example with multiple lines. #!/usr/bin/perl # DASH and space are split the same way. # HARNESS-CONFLICTS-DAEMON # HARNESS-CONFLICTS MYSQL ... =item Or on a single line. #!/usr/bin/perl # HARNESS-CONFLICTS DAEMON MYSQL ... =back =head3 HARNESS-RETRY-n This lets you specify a number (minimum n=1) of retries on test failure for a specific test. HARNESS-RETRY-1 means a failing test will be run twice and is equivalent to HARNESS-RETRY. =head3 HARNESS-NO-RETRY Use this to avoid this test being retried regardless of your retry settings. =head1 MODULE DOCS This section documents the L<App::Yath> module itself. =head2 SYNOPSIS In practice you should never need to write your own yath script, or construct an L<App::Yath> instance, or even access themain instance when yath is running. However some aspects of doing so are documented here for completeness. A minimum yath script looks like this: BEGIN { package App::Yath:Script; require Time::HiRes; require App::Yath; require Test2::Harness::Settings; my $settings = Test2::Harness::Settings->new( harness => { orig_argv => [@ARGV], orig_inc => [@INC], script => __FILE__, start => Time::HiRes::time(), version => $App::Yath::VERSION, }, ); my $app = App::Yath->new( argv => \@ARGV, config => {}, settings => $settings, ); $app->generate_run_sub('App::Yath::Script::run'); } exit(App::Yath::Script::run()); It is important that most logic live in a BEGIN block. This is so that L<goto::file> can be used post-fork to execute a test script. The actual yath script is significantly more complicated with the following behaviors: =over 4 =item pre-process essential arguments such as -D and no-scan-plugins =item re-exec with a different yath script if in developer mode and a local copy is found =item Parse the yath-rc config files =item gather and store essential startup information =back =head2 METHODS App::Yath does not provide many methods to use externally. =over 4 =item $app->generate_run_sub($symbol_name) This tells App::Yath to generate a subroutine at the specified symbol name which can be run and be expected to return an exit value. =item $lib_path = $app->app_path() Get the include directory App::Yath was loaded from. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/���������������������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�014534� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/lib/�����������������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�015302� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/lib/App/�������������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�016022� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/lib/App/Yath/��������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�016727� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/lib/App/Yath/Command/������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020305� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/lib/App/Yath/Command/broken.pm���������������������������������������������0000644�0001750�0001750�00000000104�15012417054�022116� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::Broken; die "This command is broken!"; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/lib/App/Yath/Command/fake.pm�����������������������������������������������0000644�0001750�0001750�00000000416�15012417054�021552� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::fake; use strict; use warnings; use parent 'App::Yath::Command'; use App::Yath::Options; option_group {prefix => 'fake'}, sub { option($_, short => $_) for qw/x y z/; post sub { print "\n\nAAAA\n\n"; $main::POST_HOOK++ }; }; 1; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/lib/App/Yath/Plugin/�������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020165� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/lib/App/Yath/Plugin/Options.pm���������������������������������������������0000644�0001750�0001750�00000000237�15012417054�022160� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin::Options; use strict; use warnings; use App::Yath::Options; option foobar => ( prefix => 'testplugin', type => 'b', ); 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/lib/App/Yath/Plugin/Fail.pm������������������������������������������������0000644�0001750�0001750�00000001243�15012417054�021376� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin::Test; use strict; use warnings; our $VERSION = '0.001016'; use parent 'App::Yath::Plugin'; my %CALLS; sub options { push @{$CALLS{options}} => [@_]; return } sub pre_init { push @{$CALLS{pre_init}} => [@_]; return } sub post_init { push @{$CALLS{post_init}} => [@_]; return } sub find_files { push @{$CALLS{find_files}} => [@_]; return } sub block_default_search { push @{$CALLS{block_default_search}} => [@_]; return } sub CLEAR_CALLS { %CALLS = () } sub GET_CALLS { return { %CALLS } } use Carp qw/confess/; confess "Should not see this"; 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/yath_script/���������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�017065� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/yath_script/nested/��������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020347� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/yath_script/nested/.yath.user.rc�������������������������������������������0000644�0001750�0001750�00000000603�15012417054�022674� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ; comment! -Dpre_user_lib; comment! -D=rel(pre/xxx/user/lib) ;comment! -D=rel( pre/yyy/user/lib ) -pUSER_XXX -p USER_YYY [test] -Itest_user_lib; comment! -I=rel(test/xxx/user/lib) ;comment! -I rel( test/yyy/user/lib ) -user_xxxx;comment! user_foo user_bar user_baz user_bat [run] -Irun_user_lib -I=rel(run/xxx/user/lib) -I rel( run/yyy/user/lib ) -user_xxxx user_foo user_bar �����������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/yath_script/nested/scripts/������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�022036� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/yath_script/nested/scripts/yath��������������������������������������������0000644�0001750�0001750�00000000000�15012417054�022714� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/yath_script/.yath.rc�������������������������������������������������������0000644�0001750�0001750�00000000540�15012417054�020435� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ; comment! -Dpre_lib; comment! -D=rel(pre/xxx/lib) ;comment! -D=rel( pre/yyy/lib ) -pXXX -p YYY -D SPLIT --no-scan-plugins [test] -Itest_lib; comment! -I=rel(test/xxx/lib) ;comment! -I rel( test/yyy/lib ) --default-search relglob(../*.t) -xxxx;comment! foo bar baz bat [run] -Irun_lib -I=rel(run/xxx/lib) -I rel( run/yyy/lib ) -xxxx foo bar ����������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/���������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�017057� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-broken-symlinks/������������������������������������������0000755�0001750�0001750�00000000000�15012417054�023163� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-broken-symlinks/pass.tx�����������������������������������0000644�0001750�0001750�00000000056�15012417054�024507� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-broken-symlinks/keepme������������������������������������0000644�0001750�0001750�00000000002�15012417054�024344� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������1 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-durations/������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�022044� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-durations/slow-02.tx��������������������������������������0000644�0001750�0001750�00000000053�15012417054�023622� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok 1, "$0"; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-durations/slow-01.tx��������������������������������������0000644�0001750�0001750�00000000053�15012417054�023621� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok 1, "$0"; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-durations/fast-04.tx��������������������������������������0000644�0001750�0001750�00000000053�15012417054�023575� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok 1, "$0"; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-durations/fast-03.tx��������������������������������������0000644�0001750�0001750�00000000053�15012417054�023574� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok 1, "$0"; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-durations/fast-02.tx��������������������������������������0000644�0001750�0001750�00000000053�15012417054�023573� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok 1, "$0"; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-durations/fast-01.tx��������������������������������������0000644�0001750�0001750�00000000053�15012417054�023572� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok 1, "$0"; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/verbose_env/���������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021374� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/verbose_env/not_verbose.tx�������������������������������������0000644�0001750�0001750�00000000202�15012417054�024270� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; is($ENV{T2_HARNESS_IS_VERBOSE}, 0, "Not verbose"); is($ENV{HARNESS_IS_VERBOSE}, 0, "Not verbose"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/verbose_env/verbose2.tx����������������������������������������0000644�0001750�0001750�00000000216�15012417054�023477� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; is($ENV{T2_HARNESS_IS_VERBOSE}, 2, "Verbosity level 2"); is($ENV{HARNESS_IS_VERBOSE}, 2, "Verbosity level 2"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/verbose_env/verbose1.tx����������������������������������������0000644�0001750�0001750�00000000216�15012417054�023476� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; is($ENV{T2_HARNESS_IS_VERBOSE}, 1, "Verbosity level 1"); is($ENV{HARNESS_IS_VERBOSE}, 1, "Verbosity level 1"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/retry-symlinks/������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�022073� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/retry-symlinks/symlink.tl��������������������������������������0000644�0001750�0001750�00000001152�15012417054�024121� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# HARNESS-DURATION-SHORT use strict; use warnings; use Test2::V0; use Test2::API qw/test2_formatter/; ok(1, "Minimal result"); sub { my $ctx = context(); diag "Formatter: " . test2_formatter(); $ctx->release; }->(); $ENV{T2_HARNESS_JOB_IS_TRY} //= 0; $ENV{FAIL_ONCE} //= 0; $ENV{FAIL_ALWAYS} //= 0; diag "JOB_IS_TRY = $ENV{T2_HARNESS_JOB_IS_TRY}"; diag "FAIL_ONCE = $ENV{FAIL_ONCE}"; diag "FAIL_ALWAYS = $ENV{FAIL_ALWAYS}"; ok(0, "Should fail once") if $ENV{FAIL_ONCE} && $ENV{T2_HARNESS_JOB_IS_TRY} < 1; ok(0, "Should fail always") if $ENV{FAIL_ALWAYS}; done_testing(); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/retry-symlinks/retry.tx����������������������������������������0000644�0001750�0001750�00000001152�15012417054�023614� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# HARNESS-DURATION-SHORT use strict; use warnings; use Test2::V0; use Test2::API qw/test2_formatter/; ok(1, "Minimal result"); sub { my $ctx = context(); diag "Formatter: " . test2_formatter(); $ctx->release; }->(); $ENV{T2_HARNESS_JOB_IS_TRY} //= 0; $ENV{FAIL_ONCE} //= 0; $ENV{FAIL_ALWAYS} //= 0; diag "JOB_IS_TRY = $ENV{T2_HARNESS_JOB_IS_TRY}"; diag "FAIL_ONCE = $ENV{FAIL_ONCE}"; diag "FAIL_ALWAYS = $ENV{FAIL_ALWAYS}"; ok(0, "Should fail once") if $ENV{FAIL_ONCE} && $ENV{T2_HARNESS_JOB_IS_TRY} < 1; ok(0, "Should fail always") if $ENV{FAIL_ALWAYS}; done_testing(); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-symlinks/�������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021705� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-symlinks/symlink_to_base.xt�������������������������������0000644�0001750�0001750�00000000246�15012417054�025446� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; skip_all( "Do Not Run on the Main base.t" ) if $0 =~ m{\Q/_base.xt\E$}; like $0, qr{symlink_to_base\.xt}, q[symlink preserved in $0]; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-symlinks/_base.xt�����������������������������������������0000644�0001750�0001750�00000000246�15012417054�023335� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; skip_all( "Do Not Run on the Main base.t" ) if $0 =~ m{\Q/_base.xt\E$}; like $0, qr{symlink_to_base\.xt}, q[symlink preserved in $0]; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/retry-timeout/�������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021710� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/retry-timeout/retry.tx�����������������������������������������0000644�0001750�0001750�00000000737�15012417054�023441� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# HARNESS-TIMEOUT-EVENT 5 use strict; use warnings; use Test2::V0; use Test2::API qw/test2_formatter/; pass("Test Start"); $ENV{T2_HARNESS_JOB_IS_TRY} //= 0; $ENV{FAIL_ONCE} //= 0; $ENV{FAIL_ALWAYS} //= 0; diag "JOB_IS_TRY = $ENV{T2_HARNESS_JOB_IS_TRY}"; diag "FAIL_ONCE = $ENV{FAIL_ONCE}"; diag "FAIL_ALWAYS = $ENV{FAIL_ALWAYS}"; if ( $ENV{FAIL_ONCE} && $ENV{T2_HARNESS_JOB_IS_TRY} < 1 ) { sleep 1 while 1; } pass("Final Test"); done_testing(); ���������������������������������Test2-Harness-1.000158/t/integration/reload_syntax_error.tx�����������������������������������������0000644�0001750�0001750�00000000150�15012417054�023515� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; my ($want) = @ARGV; is($Preload::Flux::VAR, $want, "Var set as expected"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020710� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/foo/��������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021473� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/foo/lib/����������������������������������������������0000755�0001750�0001750�00000000000�15012417054�022241� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/foo/lib/Foo.pm����������������������������������������0000644�0001750�0001750�00000000021�15012417054�023313� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Foo; 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/foo/lib/Baz.pm����������������������������������������0000644�0001750�0001750�00000000055�15012417054�023313� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������die "Loaded Baz.pm from the wrong project!"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/foo/lib/Bar.pm����������������������������������������0000644�0001750�0001750�00000000055�15012417054�023303� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������die "Loaded Bar.pm from the wrong project!"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/foo/t/������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021736� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/foo/t/pass.tx�����������������������������������������0000644�0001750�0001750�00000000465�15012417054�023266� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Foo; is(__FILE__, 't/pass.tx', "__FILE__ is set correctly"); like(dies { require Bar }, qr{Loaded Bar.pm from the wrong project}, "Using our own libs (Bar)"); like(dies { require Baz }, qr{Loaded Baz.pm from the wrong project}, "Using our own libs (Baz)"); ok(1, "Pass"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/baz/��������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021464� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/baz/lib/����������������������������������������������0000755�0001750�0001750�00000000000�15012417054�022232� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/baz/lib/Foo.pm����������������������������������������0000644�0001750�0001750�00000000055�15012417054�023313� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������die "Loaded Foo.pm from the wrong project!"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/baz/lib/Baz.pm����������������������������������������0000644�0001750�0001750�00000000021�15012417054�023275� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Baz; 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/baz/lib/Bar.pm����������������������������������������0000644�0001750�0001750�00000000055�15012417054�023274� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������die "Loaded Bar.pm from the wrong project!"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/baz/t/������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021727� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/baz/t/fail.txx����������������������������������������0000644�0001750�0001750�00000000056�15012417054�023410� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(0, "Fail"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/baz/t/pass.tx�����������������������������������������0000644�0001750�0001750�00000000465�15012417054�023257� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Baz; is(__FILE__, 't/pass.tx', "__FILE__ is set correctly"); like(dies { require Foo }, qr{Loaded Foo.pm from the wrong project}, "Using our own libs (Foo)"); like(dies { require Bar }, qr{Loaded Bar.pm from the wrong project}, "Using our own libs (Bar)"); ok(1, "Pass"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/bar/��������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021454� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/bar/lib/����������������������������������������������0000755�0001750�0001750�00000000000�15012417054�022222� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/bar/lib/Foo.pm����������������������������������������0000644�0001750�0001750�00000000055�15012417054�023303� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������die "Loaded Foo.pm from the wrong project!"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/bar/lib/Baz.pm����������������������������������������0000644�0001750�0001750�00000000055�15012417054�023274� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������die "Loaded Baz.pm from the wrong project!"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/bar/lib/Bar.pm����������������������������������������0000644�0001750�0001750�00000000021�15012417054�023255� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Bar; 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/bar/t/������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021717� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects/bar/t/pass.tx�����������������������������������������0000644�0001750�0001750�00000000465�15012417054�023247� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Bar; is(__FILE__, 't/pass.tx', "__FILE__ is set correctly"); like(dies { require Foo }, qr{Loaded Foo.pm from the wrong project}, "Using our own libs (Foo)"); like(dies { require Baz }, qr{Loaded Baz.pm from the wrong project}, "Using our own libs (Baz)"); ok(1, "Pass"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-inc/������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020605� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-inc/check-INC.tx������������������������������������������0000644�0001750�0001750�00000000774�15012417054�022656� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package My::Simple::Test; use Test2::V0; my $has_dot_in_inc = grep { $_ eq '.' } @INC; ok !$has_dot_in_inc, q['.' is not in @INC run with --no-unsafe-inc]; { # relative path in @INC my @relative_path = grep { index( $_, '/', 0 ) != 0 } @INC; is \@relative_path, [], q[@INC does not contain relative path]; } { # check elative path in %INC my @relative_path = grep { index( $_, '/', 0 ) != 0 } sort values %INC; is \@relative_path, [], q[%INC does not contain relative path values]; } done_testing; ����Test2-Harness-1.000158/t/integration/signals/�������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020517� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/signals/abrt_or_iot.t������������������������������������������0000644�0001750�0001750�00000000376�15012417054�023215� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!perl use strict; use warnings; use Test::More; # note: this is going to fail if IOT is defined before... # %SIG = %SIG; will introduce a flapping behavior $SIG{'ABRT'} = sub { my ($sig) = @_; is $sig, 'ABRT'; }; kill 'ABRT', $$; done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload_syntax_error.t������������������������������������������0000644�0001750�0001750�00000003303�15012417054�023330� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Require::AuthorTesting; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util qw/clean_path/; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Util qw/CAN_REALLY_FORK/; skip_all "Cannot fork, skipping preload test" if $ENV{T2_NO_FORK} || !CAN_REALLY_FORK; my $tx = __FILE__ . 'x'; my $tmpdir = tempdir(CLEANUP => 1); mkdir("$tmpdir/Preload") or die "($tmpdir/Preload) $!"; { open(my $fh, '>', "$tmpdir/Preload.pm") or die "Could not create preload: $!"; print $fh <<' EOT'; package Preload; use strict; use warnings; use Test2::Harness::Runner::Preload; stage A => sub { default(); # Do like this to avoid blacklisting preload sub { require Preload::Flux }; }; 1; EOT } sub touch { my ($inject) = @_; my $path = "$tmpdir/Preload/Flux.pm"; note "Touching $path..."; sleep 1; open(my $fh, '>', $path) or die $!; print $fh <<" EOT"; package Preload::Flux; use strict; use warnings; sub foo { 'foo' } $inject 1; EOT close($fh); sleep 2; } touch('$Preload::Flux::VAR = "initial";'); yath( command => 'start', pre => ["-D$tmpdir"], args => ["-I$tmpdir", '-PPreload'], debug => 2, exit => 0, ); yath( command => 'run', args => [$tx, '::', 'initial'], exit => 0, ); touch('$Preload::Flux::VAR = "Syntax Error $bob";'); yath( command => 'run', args => [$tx], # no arg, so undef exit => 0, ); touch('$Preload::Flux::VAR = "fixed";'); yath( command => 'run', args => [$tx, '::', 'fixed'], exit => 0, ); yath(command => 'stop', exit => 0); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/��������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020325� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/����������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021073� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload/��������������������������������������������0000755�0001750�0001750�00000000000�15012417054�022461� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload/ExceptionB.pm�������������������������������0000644�0001750�0001750�00000000371�15012417054�025060� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Preload::ExceptionB; use strict; use warnings; BEGIN { local $.; print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::ExB //= 0; die "Loaded ${ \__PACKAGE__ } again.\n" if $PRELOAD::ExB++; } sub ExB { $PRELOAD::ExB } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload/ExceptionA.pm�������������������������������0000644�0001750�0001750�00000000370�15012417054�025056� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Preload::ExceptionA; use strict; use warnings; BEGIN { local $.; print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::ExA //= 0; die "Loaded ${ \__PACKAGE__ } again.\n" if $PRELOAD::ExA++; } sub ExA { $PRELOAD::ExA } 1; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload/IncChange.pm��������������������������������0000644�0001750�0001750�00000000165�15012417054�024640� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Preload::IncChange; use strict; use warnings; BEGIN { print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload/ExporterB.pm��������������������������������0000644�0001750�0001750�00000000347�15012417054�024735� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Preload::ExporterB; use strict; use warnings; BEGIN { print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::EB //= 0; $PRELOAD::EB++; } our @EXPORT_OK = ('EB'); sub import { 1 } sub EB { $PRELOAD::EB } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload/ExporterA.pm��������������������������������0000644�0001750�0001750�00000000351�15012417054�024727� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Preload::ExporterA; use strict; use warnings; BEGIN { print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::EA //= 0; $PRELOAD::EA++; } use parent 'Exporter'; our @EXPORT_OK = 'EA'; sub EA { $PRELOAD::EA } 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload/WarningB.pm���������������������������������0000644�0001750�0001750�00000000363�15012417054�024530� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Preload::WarningB; use strict; use warnings; BEGIN { local $.; print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::WB //= 0; warn "Loaded ${ \__PACKAGE__ } again.\n" if $PRELOAD::WB++; } sub WB { $PRELOAD::WB } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload/WarningA.pm���������������������������������0000644�0001750�0001750�00000000363�15012417054�024527� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Preload::WarningA; use strict; use warnings; BEGIN { local $.; print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::WA //= 0; warn "Loaded ${ \__PACKAGE__ } again.\n" if $PRELOAD::WA++; } sub WA { $PRELOAD::WA } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload/nonperl2������������������������������������0000644�0001750�0001750�00000000003�15012417054�024134� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������2; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload/nonperl1������������������������������������0000644�0001750�0001750�00000000003�15012417054�024133� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload/Churn.pm������������������������������������0000644�0001750�0001750�00000001066�15012417054�024101� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Preload::Churn; our $counter; $counter //= 0; die "Counter incremented!" if $counter; $counter++; # HARNESS-CHURN-START our $counter2; $counter2 //= 0; print "$$ $0 - Churn 1\n"; $counter2++; my $foo = "foo $counter2"; sub foo { $foo } print "$$ $0 - FOO: " . Preload::Churn->foo . "\n"; # HARNESS-CHURN-STOP # HARNESS-CHURN-START print "$$ $0 - Churn 2\n"; # HARNESS-CHURN-STOP # HARNESS-CHURN-START our $counter3; $counter3 //= 0; die "$$ $0 - Died on count $counter3\n" if $counter3++; print "$$ $0 - Churn 3\n"; $counter3++; # HARNESS-CHURN-STOP 1; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload/B.pm����������������������������������������0000644�0001750�0001750�00000000367�15012417054�023206� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Preload::B; use strict; use warnings; BEGIN { print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::B //= 0; $PRELOAD::B++; } sub B { $PRELOAD::B } die "PreDefined sub is missing!" unless __PACKAGE__->can('PreDefined'); 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload/A.pm����������������������������������������0000644�0001750�0001750�00000000256�15012417054�023202� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Preload::A; use strict; use warnings; BEGIN { print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::A //= 0; $PRELOAD::A++; } sub A { $PRELOAD::A } 1; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload/lib/Preload.pm������������������������������������������0000644�0001750�0001750�00000002157�15012417054�023024� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Preload; use strict; use warnings; use Test2::Harness::Runner::Preload; print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; my $path = __FILE__; $path =~ s{\.pm$}{}; use Data::Dumper; print Dumper($path); stage A => sub { default(); watch "$path/nonperl1" => sub { print "$$ $0 - RELOAD CALLBACK nonperl1\n" }; preload sub { watch "$path/nonperl2" => sub { print "$$ $0 - RELOAD CALLBACK nonperl2\n" }; }; preload 'Preload::A'; preload 'Preload::WarningA'; preload 'Preload::ExceptionA'; preload 'Preload::ExporterA'; preload 'Preload::Churn'; }; stage B => sub { reload_remove_check sub { my %params = @_; return 1 if $params{reload_file} eq $params{from_file}; return 0; }; preload sub { *Preload::B::PreDefined = sub { 'yes' }; }; preload 'Preload::A'; preload 'Preload::WarningA'; preload 'Preload::ExceptionA'; preload 'Preload::ExporterA'; preload 'Preload::B'; preload 'Preload::WarningB'; preload 'Preload::ExceptionB'; preload 'Preload::ExporterB'; preload 'Preload::IncChange'; }; 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/�������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021664� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/buffered_subtest_abrupt_end_nested.tx������������0000644�0001750�0001750�00000000306�15012417054�031340� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; my $end = $ENV{FAILURE_DO_PASS} ? "}\n " : ""; print <<EOT; ok - outer { ok - foo { ok - pass 1..1 ${end}ok - bar 1..2 } 1..1 EOT exit 0; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/buffered_subtest_abrupt_end.tx�������������������0000644�0001750�0001750�00000000232�15012417054�027774� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; my $end = $ENV{FAILURE_DO_PASS} ? "}\n" : ""; print <<EOT; ok - foo { ok - pass 1..1 ${end}ok - bar 1..2 EOT exit 0; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/nested_subtest_exception.tx����������������������0000644�0001750�0001750�00000001321�15012417054�027347� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::API qw/context/; { $INC{'My/Event.pm'} = 1; package My::Event; use parent 'Test2::Event'; use Test2::Util::Facets2Legacy ':ALL'; sub facet_data { my $self = shift; my $out = $self->common_facet_data; $out->{errors} = [ { tag => 'OOPS', fail => !$ENV{FAILURE_DO_PASS}, details => "An error occured" } ]; return $out; } } subtest foo => sub { subtest bar => sub { subtest baz => sub { ok(1, "pass"); sub { my $ctx = context; $ctx->send_event('+My::Event'); $ctx->release; }->(); }; }; }; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/post_exit_timeout.tx�����������������������������0000644�0001750�0001750�00000000127�15012417054�026025� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������print <<EOT; 1..2 ok foo EOT exit(0) unless $ENV{FAILURE_DO_PASS}; print "ok bar\n"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/nested_subtest.tx��������������������������������0000644�0001750�0001750�00000000263�15012417054�025275� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; subtest foo => sub { subtest bar => sub { subtest baz => sub { ok($ENV{FAILURE_DO_PASS}, "check env"); }; }; }; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/parse_error.tx�����������������������������������0000644�0001750�0001750�00000000226�15012417054�024564� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use goto::file( $ENV{FAILURE_DO_PASS} ? ['ok(1); done_testing;'] : ['ok(; done_testing;'] ); die "Should not see this!"; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/missingnums.tx�����������������������������������0000644�0001750�0001750�00000000166�15012417054�024620� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������my $i = 1; print "ok " . $i++ . "\n"; $i++ unless $ENV{FAILURE_DO_PASS}; print "ok " . $i++ . "\n"; print "1..2\n"; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/timeout.tx���������������������������������������0000644�0001750�0001750�00000000126�15012417054�023726� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::Tools::Tiny; sleep 60 unless $ENV{FAILURE_DO_PASS}; ok(1); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/subtest.tx���������������������������������������0000644�0001750�0001750�00000000143�15012417054�023730� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; subtest foo => sub { ok($ENV{FAILURE_DO_PASS}, "check env"); }; done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/dupnums.tx���������������������������������������0000644�0001750�0001750�00000000243�15012417054�023733� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������my $out = <<EOT; ok 1 - foo ok 2 - bar ok 3 - baz EOT print $out; print $out unless $ENV{FAILURE_DO_PASS}; print "1.." . ($ENV{FAILURE_DO_PASS} ? 3 : 6) . "\n"; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/badplan.tx���������������������������������������0000644�0001750�0001750�00000000124�15012417054�023637� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������print <<EOT; 1..2 ok foo ok bar EOT print "ok baz\n" unless $ENV{FAILURE_DO_PASS}; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/noplan.tx����������������������������������������0000644�0001750�0001750�00000000111�15012417054�023521� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������print <<EOT; ok foo ok bar EOT print "1..2\n" if $ENV{FAILURE_DO_PASS}; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/notok.tx�����������������������������������������0000644�0001750�0001750�00000000120�15012417054�023364� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::Tools::Tiny; ok($ENV{FAILURE_DO_PASS}, "check env"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases/exit.tx������������������������������������������0000644�0001750�0001750�00000000161�15012417054�023210� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::Tools::Tiny; use strict; use warnings; ok(1); done_testing; exit(123) unless $ENV{FAILURE_DO_PASS}; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-durations.json��������������������������������������������0000644�0001750�0001750�00000000476�15012417054�022746� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{ "t/integration/test-durations/fast-01.tx": "SHORT", "t/integration/test-durations/fast-02.tx": "SHORT", "t/integration/test-durations/fast-03.tx": "SHORT", "t/integration/test-durations/fast-04.tx": "SHORT", "t/integration/test-durations/slow-01.tx": "LONG", "t/integration/test-durations/slow-02.tx": "LONG" }��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/tapsubtest/����������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021255� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/tapsubtest/test.tx���������������������������������������������0000644�0001750�0001750�00000000243�15012417054�022610� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# HARNESS-NO-STREAM use Test2::V0; use Test2::Tools::Subtest qw/subtest_buffered/; subtest_buffered buffered => sub { ok(1, "buffered ok"); }; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/encoding/������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020645� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/encoding/no-plugin.tx������������������������������������������0000644�0001750�0001750�00000001112�15012417054�023125� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; note "valid note [“”\xff\xff]"; note "valid note [“”]"; diag "valid diag [“”\xff\xff]"; diag "valid diag [“”]"; print "valid stdout [“”\xff\xff]\n"; print "valid stdout [“”]\n"; print STDERR "valid stderr [“”\xff\xff]\n"; print STDERR "valid stderr [“”]\n"; ok 1, "valid ok [“”\xff\xff]"; ok 1, "valid ok [“”]"; print STDOUT "STDOUT: Mākaha\n"; print STDERR "STDERR: Mākaha\n"; diag "DIAG: Mākaha"; note "NOTE: Mākaha"; ok(1, "ASSERT: Mākaha"); ok(1, "І ще трохи"); done_testing(); ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/encoding/plugin.tx���������������������������������������������0000644�0001750�0001750�00000001142�15012417054�022516� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Test2::Plugin::UTF8; note "valid note [“”\xff\xff]"; note "valid note [“”]"; diag "valid diag [“”\xff\xff]"; diag "valid diag [“”]"; print "valid stdout [“”\xff\xff]\n"; print "valid stdout [“”]\n"; print STDERR "valid stderr [“”\xff\xff]\n"; print STDERR "valid stderr [“”]\n"; ok 1, "valid ok [“”\xff\xff]"; ok 1, "valid ok [“”]"; print STDOUT "STDOUT: Mākaha\n"; print STDERR "STDERR: Mākaha\n"; diag "DIAG: Mākaha"; note "NOTE: Mākaha"; ok(1, "ASSERT: Mākaha"); ok(1, "І ще трохи"); done_testing(); ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/includes/������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020665� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/includes/order-ilibi.tx����������������������������������������0000644�0001750�0001750�00000001162�15012417054�023443� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; my @parts = File::Spec->splitpath(File::Spec->rel2abs(__FILE__)); pop @parts; my $path = File::Spec->catpath(@parts); require App::Yath; like( \@INC, [ App::Yath->app_path, File::Spec->catdir($path, 'a'), File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'b'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), File::Spec->catdir($path, 'c'), ], "Added all via cli, in order" ); is($ENV{PERL5LIB}, $ENV{OLD_PERL5LIB}, "PERL5LIB has not been modified"); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/includes/order-ibili.tx����������������������������������������0000644�0001750�0001750�00000001162�15012417054�023443� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; my @parts = File::Spec->splitpath(File::Spec->rel2abs(__FILE__)); pop @parts; my $path = File::Spec->catpath(@parts); require App::Yath; like( \@INC, [ App::Yath->app_path, File::Spec->catdir($path, 'a'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), File::Spec->catdir($path, 'b'), File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'c'), ], "Added all via cli, in order" ); is($ENV{PERL5LIB}, $ENV{OLD_PERL5LIB}, "PERL5LIB has not been modified"); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/includes/default-i.tx������������������������������������������0000644�0001750�0001750�00000001066�15012417054�023117� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; my @parts = File::Spec->splitpath(File::Spec->rel2abs(__FILE__)); pop @parts; my $path = File::Spec->catpath(@parts); require App::Yath; like( \@INC, [ App::Yath->app_path, File::Spec->catdir($path, 'xyz'), File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), ], "Added lib, blib/lib, and blib/arch AFTER the -Ixyz" ); is($ENV{PERL5LIB}, $ENV{OLD_PERL5LIB}, "PERL5LIB has not been modified"); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/includes/not-perl.sh�������������������������������������������0000755�0001750�0001750�00000000060�15012417054�022760� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/env bash exec $YATH_PERL not-perl.pl ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/includes/not-perl.pl�������������������������������������������0000644�0001750�0001750�00000001512�15012417054�022761� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; use Config qw/%Config/; my @parts = File::Spec->splitpath(File::Spec->rel2abs(__FILE__)); pop @parts; my $path = File::Spec->catpath(@parts); use App::Yath; like( \@INC, [ App::Yath->app_path, File::Spec->catdir($path, 'xyz'), File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), ], "Added all the expected paths in order" ); like( [split $Config{path_sep}, $ENV{PERL5LIB}], [ App::Yath->app_path, File::Spec->catdir($path, 'xyz'), File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), ], "When running non-perl the libs were added via PERL5LIB" ); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/includes/dot-last.tx�������������������������������������������0000644�0001750�0001750�00000001105�15012417054�022766� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; my @parts = File::Spec->splitpath(File::Spec->rel2abs(__FILE__)); pop @parts; my $path = File::Spec->catpath(@parts); require App::Yath; like( \@INC, [ App::Yath->app_path, File::Spec->catdir($path, 'xyz'), File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), ], "Added all via cli, in order" ); is($INC[-1], '.', "Dot added last"); is($ENV{PERL5LIB}, $ENV{OLD_PERL5LIB}, "PERL5LIB has not been modified"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/includes/default.tx��������������������������������������������0000644�0001750�0001750�00000001025�15012417054�022664� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; require App::Yath; use File::Spec; my @parts = File::Spec->splitpath(File::Spec->rel2abs(__FILE__)); pop @parts; my $path = File::Spec->catpath(@parts); like( \@INC, [ App::Yath->app_path, File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), ], "Added lib, blib/lib, and blib/arch to the front of the line" ); is($ENV{PERL5LIB}, $ENV{OLD_PERL5LIB}, "PERL5LIB has not been modified"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/includes/.yath.rc����������������������������������������������0000644�0001750�0001750�00000000007�15012417054�022233� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������[test] �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/speedtag/������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020653� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/speedtag/pass2.tx����������������������������������������������0000644�0001750�0001750�00000000056�15012417054�022261� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/speedtag/pass.tx�����������������������������������������������0000644�0001750�0001750�00000000056�15012417054�022177� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/slots_per_job3.t�����������������������������������������������0000644�0001750�0001750�00000000625�15012417054�022176� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-JOB-SLOTS 2 skip_all "This test only works under Test2::Harness" unless $ENV{TEST2_HARNESS_ACTIVE}; ok(!$ENV{T2_HARNESS_JOB_CONCURRENCY}, "T2_HARNESS_JOB_CONCURRENCY is not set"); ok($ENV{T2_HARNESS_MY_JOB_CONCURRENCY}, "Have job concurrency set ($ENV{T2_HARNESS_MY_JOB_CONCURRENCY})"); is($ENV{T2_HARNESS_MY_JOB_CONCURRENCY}, 2, "Have job concurrency set (2)"); done_testing; �����������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/slots_per_job2.t�����������������������������������������������0000644�0001750�0001750�00000000737�15012417054�022201� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use List::Util qw/min/; # HARNESS-JOB-SLOTS 1 3 skip_all "This test only works under Test2::Harness" unless $ENV{TEST2_HARNESS_ACTIVE}; ok(!$ENV{T2_HARNESS_JOB_CONCURRENCY}, "T2_HARNESS_JOB_CONCURRENCY is not set"); ok($ENV{T2_HARNESS_MY_JOB_CONCURRENCY}, "Have job concurrency set ($ENV{T2_HARNESS_MY_JOB_CONCURRENCY})"); is($ENV{T2_HARNESS_MY_JOB_CONCURRENCY}, in_set(1, 2, 3), "Have job concurrency set ($ENV{T2_HARNESS_MY_JOB_CONCURRENCY})"); done_testing; ���������������������������������Test2-Harness-1.000158/t/integration/concurrency/���������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021411� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/concurrency/e.tx�����������������������������������������������0000644�0001750�0001750�00000000100�15012417054�022201� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; sleep 1; ok(1, "pass"); sleep 1; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/concurrency/d.tx�����������������������������������������������0000644�0001750�0001750�00000000100�15012417054�022200� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; sleep 1; ok(1, "pass"); sleep 1; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/concurrency/c.tx�����������������������������������������������0000644�0001750�0001750�00000000100�15012417054�022177� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; sleep 1; ok(1, "pass"); sleep 1; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/concurrency/b.tx�����������������������������������������������0000644�0001750�0001750�00000000100�15012417054�022176� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; sleep 1; ok(1, "pass"); sleep 1; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/concurrency/a.tx�����������������������������������������������0000644�0001750�0001750�00000000100�15012417054�022175� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; sleep 1; ok(1, "pass"); sleep 1; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/slots_per_job.t������������������������������������������������0000644�0001750�0001750�00000000670�15012417054�022113� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; skip_all "This test only works under Test2::Harness" unless $ENV{TEST2_HARNESS_ACTIVE}; ok(!$ENV{T2_HARNESS_JOB_CONCURRENCY}, "T2_HARNESS_JOB_CONCURRENCY is not set"); ok($ENV{T2_HARNESS_MY_JOB_CONCURRENCY}, "Have job concurrency set ($ENV{T2_HARNESS_MY_JOB_CONCURRENCY})"); ok($ENV{T2_HARNESS_MY_JOB_CONCURRENCY} >= 1, "Have job concurrency set to a positive number ($ENV{T2_HARNESS_MY_JOB_CONCURRENCY})"); done_testing; ������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/persist/�������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020550� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/persist/fail.txx�����������������������������������������������0000644�0001750�0001750�00000000056�15012417054�022231� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(0, "Fail"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/persist/pass.tx������������������������������������������������0000644�0001750�0001750�00000000056�15012417054�022074� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failure_cases.t������������������������������������������������0000644�0001750�0001750�00000002030�15012417054�022044� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-DURATION-LONG use Test2::API qw/context/; use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my %CUSTOM = ( "timeout.tx" => ['--et', 2], "post_exit_timeout.tx" => ['--pet', 2], "noplan.tx" => ['--pet', 2], "dupnums.tx" => [], "missingnums.tx" => [], ); opendir(my $DH, $dir) or die "Could not open directory $dir: $!"; for my $file (readdir($DH)) { run_test($file); } sub run_test { my ($file) = @_; my $path = File::Spec->canonpath("$dir/$file"); return unless -f $path; my $args = $CUSTOM{$file}; my $ctx = context(); my @final_args = (@{$args || []}, $path); yath( command => 'test', args => \@final_args, env => {FAILURE_DO_PASS => 0}, exit => T(), ); yath( command => 'test', args => \@final_args, env => {FAILURE_DO_PASS => 1}, exit => F(), ); $ctx->release; } done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/stamps/��������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020366� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/stamps/lib/����������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021134� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/stamps/lib/App/������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021654� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/stamps/lib/App/Yath/�������������������������������������������0000755�0001750�0001750�00000000000�15012417054�022561� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/stamps/lib/App/Yath/Plugin/������������������������������������0000755�0001750�0001750�00000000000�15012417054�024017� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/stamps/lib/App/Yath/Plugin/TestPlugin.pm�����������������������0000644�0001750�0001750�00000000426�15012417054�026455� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin::TestPlugin; use strict; use warnings; use Test2::Harness::Util::JSON qw/encode_json/; use parent 'App::Yath::Plugin'; sub handle_event { my $self = shift; my ($event) = @_; die "Event did not have a stamp!" unless $event->stamp; } 1; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/stamps/pass.tx�������������������������������������������������0000644�0001750�0001750�00000000056�15012417054�021712� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/stamps/fail.tx�������������������������������������������������0000644�0001750�0001750�00000000056�15012417054�021657� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(0, "Fail"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/retry/���������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020224� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/retry/retry.tx�������������������������������������������������0000644�0001750�0001750�00000001152�15012417054�021745� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# HARNESS-DURATION-SHORT use strict; use warnings; use Test2::V0; use Test2::API qw/test2_formatter/; ok(1, "Minimal result"); sub { my $ctx = context(); diag "Formatter: " . test2_formatter(); $ctx->release; }->(); $ENV{T2_HARNESS_JOB_IS_TRY} //= 0; $ENV{FAIL_ONCE} //= 0; $ENV{FAIL_ALWAYS} //= 0; diag "JOB_IS_TRY = $ENV{T2_HARNESS_JOB_IS_TRY}"; diag "FAIL_ONCE = $ENV{FAIL_ONCE}"; diag "FAIL_ALWAYS = $ENV{FAIL_ALWAYS}"; ok(0, "Should fail once") if $ENV{FAIL_ONCE} && $ENV{T2_HARNESS_JOB_IS_TRY} < 1; ok(0, "Should fail always") if $ENV{FAIL_ALWAYS}; done_testing(); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/replay/��������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020353� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/replay/pass.tx�������������������������������������������������0000644�0001750�0001750�00000000056�15012417054�021677� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/replay/fail.tx�������������������������������������������������0000644�0001750�0001750�00000000056�15012417054�021644� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(0, "Fail"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/�������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020505� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/preload_test.tx����������������������������������������0000644�0001750�0001750�00000000120�15012417054�023540� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($INC{'TestPreload.pm'}, "Preload is loaded"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/simple_test.tx�����������������������������������������0000644�0001750�0001750�00000000126�15012417054�023411� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($INC{'TestSimplePreload.pm'}, "Preload is loaded"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/no_preload.tx������������������������������������������0000644�0001750�0001750�00000000175�15012417054�023207� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-NO-PRELOAD is($ENV{T2_HARNESS_STAGE}, 'NOPRELOAD', "Running in 'NOPRELOAD' stage"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/lib/���������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021253� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/lib/TestSimplePreload.pm�������������������������������0000644�0001750�0001750�00000000037�15012417054�025211� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package TestSimplePreload; 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/lib/TestBadPreload.pm����������������������������������0000644�0001750�0001750�00000000265�15012417054�024451� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package TestBadPreload; use strict; use warnings; use Test2::Harness::Runner::Preload; stage BAD => sub { default; preload "Test2::Harness::Preload::Does::Not::Exist"; }; 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/lib/TestPreload.pm�������������������������������������0000644�0001750�0001750�00000002531�15012417054�024040� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package TestPreload; use strict; use warnings; use Time::HiRes qw/sleep time/; use File::Temp qw/tempdir/; use File::Spec; use Test2::Harness::Runner::Preload; my $dir = tempdir(CLEANUP => 1); my $TRIGGER = File::Spec->catfile($dir, 'trigger'); file_stage sub { my ($file) = @_; return uc($1) if $file =~ m/(AAA|BBB)\.tx$/i; return; }; stage AAA => sub { preload 'AAA'; stage BBB => sub { preload 'BBB'; }; }; our %HOOKS; stage CCC => sub { $HOOKS{INIT} = [time(), $$]; pre_fork sub { $HOOKS{PRE_FORK} = [time(), $$] }; post_fork sub { $HOOKS{POST_FORK} = [time(), $$] }; pre_launch sub { $HOOKS{PRE_LAUNCH} = [time(), $$] }; preload 'CCC'; }; stage FAST => sub { eager; default; preload 'FAST'; preload sub { eval <<" EOT" or die $@; #line ${ \__LINE__ } "${ \__FILE__ }" END { return unless \$0 =~ m/slow\.tx/; open(my \$fh, '>', "$TRIGGER") or die "XXX"; print \$fh "\n"; close(\$fh); } 1; EOT }; stage SLOW => sub { preload sub { print "$0 pending...\n"; use Carp qw/cluck/; local $SIG{ALRM} = sub { cluck "oops"; exit 255 }; alarm 5; until (-f $TRIGGER) { print "$0 Waiting...\n"; sleep 0.2 } }; }; }; 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/lib/Broken.pm������������������������������������������0000644�0001750�0001750�00000000047�15012417054�023032� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Broken; die "This is broken"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/lib/FAST.pm��������������������������������������������0000644�0001750�0001750�00000000021�15012417054�022337� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package FAST; 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/lib/CCC.pm���������������������������������������������0000644�0001750�0001750�00000000020�15012417054�022171� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package CCC; 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/lib/BBB.pm���������������������������������������������0000644�0001750�0001750�00000000020�15012417054�022166� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package BBB; 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/lib/AAA.pm���������������������������������������������0000644�0001750�0001750�00000000020�15012417054�022163� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package AAA; 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/retry.tx�����������������������������������������������0000644�0001750�0001750�00000000142�15012417054�022224� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; #HARNESS-RETRY ok($ENV{T2_HARNESS_JOB_IS_TRY}, "This is a retry"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/slow.tx������������������������������������������������0000644�0001750�0001750�00000000263�15012417054�022047� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; #HARNESS-STAGE-SLOW ok($INC{'FAST.pm'}, "Preloaded fast"); is($ENV{T2_HARNESS_STAGE}, 'FAST', "Running in 'FAST' stage despite asking for 'SLOW'"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/fast.tx������������������������������������������������0000644�0001750�0001750�00000000205�15012417054�022014� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($INC{'FAST.pm'}, "Preloaded fast"); is($ENV{T2_HARNESS_STAGE}, 'FAST', "Running in 'FAST' stage"); done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/ccc.tx�������������������������������������������������0000644�0001750�0001750�00000001372�15012417054�021615� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; #HARNESS-STAGE-CCC is($ENV{T2_HARNESS_STAGE}, 'CCC', "Running in stage 'CCC'"); ok($INC{'CCC.pm'}, "Preloaded CCC"); is( [sort { $TestPreload::HOOKS{$a}->[0] <=> $TestPreload::HOOKS{$b}->[0] } keys %TestPreload::HOOKS], [qw/INIT PRE_FORK POST_FORK PRE_LAUNCH/], "Hooks happened in order" ); is( $TestPreload::HOOKS{POST_FORK}->[1], $TestPreload::HOOKS{PRE_LAUNCH}->[1], "POST_FORK and PRE_LAUNCH happened in the same PID" ); isnt( $TestPreload::HOOKS{POST_FORK}->[1], $TestPreload::HOOKS{INIT}->[1], "POST_FORK and INIT are not in the same PID" ); isnt( $TestPreload::HOOKS{POST_FORK}->[1], $TestPreload::HOOKS{PRE_FORK}->[1], "POST_FORK and PRE_FORK are not in the same PID" ); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/bbb.tx�������������������������������������������������0000644�0001750�0001750�00000000201�15012417054�021600� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; is($ENV{T2_HARNESS_STAGE}, 'BBB', "Running in stage 'BBB'"); ok($INC{'BBB.pm'}, "Preloaded BBB"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload/aaa.tx�������������������������������������������������0000644�0001750�0001750�00000000201�15012417054�021575� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; is($ENV{T2_HARNESS_STAGE}, 'AAA', "Running in stage 'AAA'"); ok($INC{'AAA.pm'}, "Preloaded AAA"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/log_dir/�������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020476� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/log_dir/foo.tx�������������������������������������������������0000644�0001750�0001750�00000000056�15012417054�021637� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failed/��������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020303� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failed/pass.tx�������������������������������������������������0000644�0001750�0001750�00000000056�15012417054�021627� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failed/fail.tx�������������������������������������������������0000644�0001750�0001750�00000000056�15012417054�021574� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(0, "Fail"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/verbose_env.t��������������������������������������������������0000644�0001750�0001750�00000001424�15012417054�021562� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Config qw/%Config/; use File::Temp qw/tempfile/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util qw/clean_path/; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; # Make it very wrong to start local $ENV{T2_HARNESS_IS_VERBOSE} = 99; local $ENV{HARNESS_IS_VERBOSE} = 99; yath( command => 'test', args => [File::Spec->catfile($dir, "not_verbose.tx")], exit => F(), ); yath( command => 'test', args => ['-v', File::Spec->catfile($dir, "verbose1.tx")], exit => F(), ); yath( command => 'test', args => ['-vv', File::Spec->catfile($dir, "verbose2.tx")], exit => F(), ); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/times/���������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020200� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/times/pass2.tx�������������������������������������������������0000644�0001750�0001750�00000000056�15012417054�021606� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/times/pass.tx��������������������������������������������������0000644�0001750�0001750�00000000056�15012417054�021524� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/resource/������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020706� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/resource/Resource.pm�������������������������������������������0000644�0001750�0001750�00000002517�15012417054�023040� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Resource; use strict; use warnings; use parent 'Test2::Harness::Runner::Resource'; my $limit = 2; my $no_slots_msg = 0; sub available { my $self = shift; my ($task) = @_; for my $slot (1 .. $limit) { return 1 unless defined $self->{$slot}; } $self->message("No Slots") unless $no_slots_msg++; return 0; } sub assign { my $self = shift; my ($task, $state) = @_; for my $slot (1 .. $limit) { next if defined $self->{$slot}; $self->message("Assigned: $task->{job_id} - $slot"); $state->{record} = $slot; $state->{env_vars}->{RESOURCE_TEST} = $slot; push @{$state->{args}} => $slot; return; } die "Error, no slots to assign"; } sub record { my $self = shift; my ($job_id, $slot) = @_; $self->message("Record: $job_id - $slot"); $self->{$slot} = $job_id; $self->{$job_id} = $slot; } sub release { my $self = shift; my ($job_id) = @_; my $slot = delete $self->{$job_id}; delete $self->{$slot}; $self->message("Release: $job_id - $slot"); } sub cleanup { my $self = shift; $self->message("RESOURCE CLEANUP"); } my $pid; sub message { my $self = shift; my ($msg) = @_; if (!$pid || $$ != $pid) { $pid = $$; print "$$ - $0\n"; } print "$$ - $msg\n"; } 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/resource/d.tx��������������������������������������������������0000644�0001750�0001750�00000000247�15012417054�021511� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($ENV{RESOURCE_TEST}, "Set the env var"); is($ARGV[0], $ENV{RESOURCE_TEST}, "Set the test cli argument to the same value"); sleep 1; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/resource/c.tx��������������������������������������������������0000644�0001750�0001750�00000000247�15012417054�021510� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($ENV{RESOURCE_TEST}, "Set the env var"); is($ARGV[0], $ENV{RESOURCE_TEST}, "Set the test cli argument to the same value"); sleep 1; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/resource/b.tx��������������������������������������������������0000644�0001750�0001750�00000000247�15012417054�021507� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($ENV{RESOURCE_TEST}, "Set the env var"); is($ARGV[0], $ENV{RESOURCE_TEST}, "Set the test cli argument to the same value"); sleep 1; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/resource/a.tx��������������������������������������������������0000644�0001750�0001750�00000000247�15012417054�021506� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($ENV{RESOURCE_TEST}, "Set the env var"); is($ARGV[0], $ENV{RESOURCE_TEST}, "Set the test cli argument to the same value"); sleep 1; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage/������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020652� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage/lib/��������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021420� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage/lib/Manager.pm����������������������������������������0000644�0001750�0001750�00000001251�15012417054�023327� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Manager; use strict; use warnings; sub test_parameters { my $class = shift; my ($test, $coverage_data) = @_; my %seen; my @subtests; for my $set (values %$coverage_data) { for my $value (@$set) { next unless ref $value eq 'HASH'; my $subtest = $value->{subtest} or next; next if $seen{$subtest}++; push @subtests => $subtest; } } return unless @subtests; @subtests = sort @subtests; return { run => 1, env => { COVER_TEST_SUBTESTS => join(", " => @subtests) }, argv => \@subtests, stdin => join("\n" => @subtests) . "\n", }; } 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage/lib/Plugin.pm�����������������������������������������0000644�0001750�0001750�00000001566�15012417054�023224� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Plugin; use strict; use warnings; use parent 'App::Yath::Plugin'; sub changed_files { return () unless $ENV{TEST_CASE}; return (['Ax.pm']) if $ENV{TEST_CASE} eq 'Ax'; return (['Bx.pm']) if $ENV{TEST_CASE} eq 'Bx'; return (['Cx.pm']) if $ENV{TEST_CASE} eq 'Cx'; return (['Bx.pm', 'b']) if $ENV{TEST_CASE} eq 'Bxb'; return (['Cx.pm', 'c']) if $ENV{TEST_CASE} eq 'Cxc'; return (['Ax.pm', '*']) if $ENV{TEST_CASE} eq 'Ax*'; return (['Ax.pm', 'a']) if $ENV{TEST_CASE} eq 'Axa'; return (['Ax.pm', 'aa']) if $ENV{TEST_CASE} eq 'Axaa'; return (['Ax.pm', 'aa', 'a']) if $ENV{TEST_CASE} eq 'Axaaa'; return (['Ax.pm', 'a'], ['Cx.pm', 'c']) if $ENV{TEST_CASE} eq 'AxCx'; return (); } 1; ������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage/lib/Cx.pm���������������������������������������������0000644�0001750�0001750�00000000071�15012417054�022326� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Cx; use strict; use warnings; sub c { 'c' } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage/lib/Bx.pm���������������������������������������������0000644�0001750�0001750�00000000071�15012417054�022325� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Bx; use strict; use warnings; sub b { 'b' } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage/lib/Ax.pm���������������������������������������������0000644�0001750�0001750�00000000206�15012417054�022324� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Ax; use strict; use warnings; # This is here for simulating a non-sub change my $A = 'a'; sub a { 'a' } sub aa { 'aa' } 1; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage/open.tx�����������������������������������������������0000644�0001750�0001750�00000000735�15012417054�022175� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Plugin::Cover; use Path::Tiny; use Test2::Harness::Util::JSON qw/encode_json/; STDIN->blocking(0); Test2::Plugin::Cover->set_root(path('t/integration/coverage/lib')->realpath); print "INPUT ${ \__FILE__ }: " . encode_json({ env => {map { ($_ => $ENV{$_}) } grep { m/^COVER_TEST_/ } keys %ENV}, argv => [@ARGV], stdin => join('' => <STDIN>), }) . "\n"; open(my $fh, '<', "t/integration/coverage/lib/Bx.pm"); ok(1); done_testing; �����������������������������������Test2-Harness-1.000158/t/integration/coverage/once.tx�����������������������������������������������0000644�0001750�0001750�00000000643�15012417054�022156� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Plugin::Cover; use Path::Tiny; use Test2::Harness::Util::JSON qw/encode_json/; STDIN->blocking(0); print "INPUT ${ \__FILE__ }: " . encode_json({ env => {map { ($_ => $ENV{$_}) } grep { m/^COVER_TEST_/ } keys %ENV}, argv => [@ARGV], stdin => join('' => <STDIN>), }) . "\n"; ok(1); Test2::Plugin::Cover->set_root(path('t/integration/coverage/lib')->realpath); done_testing; ���������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage/x.tx��������������������������������������������������0000644�0001750�0001750�00000000661�15012417054�021501� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Plugin::Cover; use Path::Tiny; use Test2::Harness::Util::JSON qw/encode_json/; STDIN->blocking(0); Test2::Plugin::Cover->set_root(path('t/integration/coverage/lib')->realpath); print "INPUT ${ \__FILE__ }: " . encode_json({ env => {map { ($_ => $ENV{$_}) } grep { m/^COVER_TEST_/ } keys %ENV}, argv => [@ARGV], stdin => join('' => <STDIN>), }) . "\n"; require Bx; ok(1); done_testing; �������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage/c.tx��������������������������������������������������0000644�0001750�0001750�00000001500�15012417054�021445� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Plugin::Cover; use Path::Tiny; use Test2::Harness::Util::JSON qw/encode_json/; Test2::Plugin::Cover->set_from_manager('Manager'); Test2::Plugin::Cover->set_root(path('t/integration/coverage/lib')->realpath); STDIN->blocking(0); print "INPUT ${ \__FILE__ }: " . encode_json({ env => {map { ($_ => $ENV{$_}) } grep { m/^COVER_TEST_/ } keys %ENV}, argv => [@ARGV], stdin => join('' => <STDIN>), }) . "\n"; subtest a => sub { Test2::Plugin::Cover->set_from({subtest => 'a'}); require Ax; is(Ax->a, 'a', "Got a"); Test2::Plugin::Cover->clear_from(); }; subtest c => sub { Test2::Plugin::Cover->set_from({subtest => 'c'}); require Ax; require Cx; is(Ax->a, 'a', "Got a"); is(Cx->c, 'c', "Got c"); Test2::Plugin::Cover->clear_from(); }; done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage/b.tx��������������������������������������������������0000644�0001750�0001750�00000000677�15012417054�021462� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Plugin::Cover; use Path::Tiny; use Test2::Harness::Util::JSON qw/encode_json/; STDIN->blocking(0); Test2::Plugin::Cover->set_root(path('t/integration/coverage/lib')->realpath); print "INPUT ${ \__FILE__ }: " . encode_json({ env => {map { ($_ => $ENV{$_}) } grep { m/^COVER_TEST_/ } keys %ENV}, argv => [@ARGV], stdin => join('' => <STDIN>), }) . "\n"; use Bx; is(Bx->b, 'b', "Got b"); done_testing; �����������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage/a.tx��������������������������������������������������0000644�0001750�0001750�00000002057�15012417054�021453� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Plugin::Cover; use Path::Tiny; use Test2::Harness::Util::JSON qw/encode_json/; STDIN->blocking(0); print "INPUT ${ \__FILE__ }: " . encode_json({ env => {map { ($_ => $ENV{$_}) } grep { m/^COVER_TEST_/ } keys %ENV}, argv => [@ARGV], stdin => join('' => <STDIN>), }) . "\n"; use Ax; use Bx; use Cx; Test2::Plugin::Cover->set_from_manager('Manager'); Test2::Plugin::Cover->set_root(path('t/integration/coverage/lib')->realpath); is(Cx->c, 'c', "Got c"); subtest a => sub { Test2::Plugin::Cover->set_from({subtest => 'a'}); is(Ax->a, 'a', "Got a"); is(Ax->aa, 'aa', "Got aa"); Test2::Plugin::Cover->clear_from(); }; subtest b => sub { Test2::Plugin::Cover->set_from({subtest => 'b'}); is(Ax->a, 'a', "Got a"); is(Bx->b, 'b', "Got b"); Test2::Plugin::Cover->clear_from(); }; subtest c => sub { Test2::Plugin::Cover->set_from({subtest => 'c'}); is(Ax->a, 'a', "Got a"); is(Bx->b, 'b', "Got b"); is(Cx->c, 'c', "Got c"); Test2::Plugin::Cover->clear_from(); }; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/concurrency.t��������������������������������������������������0000644�0001750�0001750�00000007472�15012417054�021610� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', args => [$dir, '--ext=tx', '-j4'], log => 1, exit => 0, test => sub { my $out = shift; my $log = $out->{log}; my @order; my @events = $log->poll(); while (@events) { if (my $event = shift @events) { my $f = $event->{facet_data}; if (my $e = $f->{harness_job_exit}) { push @order => [exit => $e->{stamp}]; } if (my $l = $f->{harness_job_start}) { push @order => [start => $l->{stamp}]; } } # Check for additional events, probably should not have any, but we may hit # a buffering limit in the log reader and need additional polls. push @events => $log->poll; } # We care about the order in which events happened based on time stamp, not the # order in which they were collected, which may be different. Here we will sort # based on stamp. @order = map { $_->[0] } sort { $a->[1] <=> $b->[1] } @order; # The first 4 events should be starts since we have 4 concurrent jobs # After they start we MUST see an exit before any more can start # Because of IPC timing we cannot be sure of the order of anything else, but we # should have 1 more start and 4 more exits in any order. like(shift @order, qr/start/, "Item $_ is 'start'") for 0 .. 3; like(shift @order, qr/exit/, "Item 4 must be an exit"); like( \@order, bag { item qr/start/; item qr/exit/ for 1 .. 4; end; }, "Got one more start, and 4 more exits" ); }, ); yath( command => 'test', args => [$dir, '--ext=tx', '-j2'], log => 1, exit => 0, test => sub { my $out = shift; my $log = $out->{log}; my @order; my @events = $log->poll(); while (@events) { if (my $event = shift @events) { my $f = $event->{facet_data}; if (my $e = $f->{harness_job_exit}) { push @order => [exit => $e->{stamp}]; } if (my $l = $f->{harness_job_start}) { push @order => [start => $l->{stamp}]; } } # Check for additional events, probably should not have any, but we may hit # a buffering limit in the log reader and need additional polls. push @events => $log->poll; } # We care about the order in which events happened based on time stamp, not the # order in which they were collected, which may be different. Here we will sort # based on stamp. @order = map { $_->[0] } sort { $a->[1] <=> $b->[1] } @order; # The first 2 events should be starts since we have 2 concurrent jobs # After they start we MUST see an exit before any more can start. # Following that we should either see a start, or, if we want to be generous # and assume the first 2 tests happened to finish at approx. the same time, # then another exit followed by 2 starts. like(shift @order, qr/start/, "Item $_ is 'start'") for 0 .. 1; like(shift @order, qr/exit/, "Item 2 must be an exit"); my $next = shift @order; if ($next =~ /exit/) { like(shift @order, qr/start/, "Item 4 must be a start if 3 was exit"); like(shift @order, qr/start/, "Item 5 must be a start if 3 was exit"); } else { like($next, qr/start/, "Item 3 must be a start"); } }, ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test/����������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020036� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test/pass.txxx�������������������������������������������������0000644�0001750�0001750�00000000150�15012417054�021735� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; is (scalar @ARGV, 2); is ( $ARGV[0], 'foobar'); is ( $ARGV[1], 'baz'); done_testing(); ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test/fail.txx��������������������������������������������������0000644�0001750�0001750�00000000056�15012417054�021517� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(0, "Fail"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test/pass.tx���������������������������������������������������0000644�0001750�0001750�00000000056�15012417054�021362� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/tapsubtest.t���������������������������������������������������0000644�0001750�0001750�00000001152�15012417054�021441� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', args => [$dir, '--ext=tx', '-v'], exit => 0, test => sub { my $todo = todo "FIXME #216"; my $out = shift; chomp(my $want = <<' EOT'); [ PASS ] job 1 +~buffered [ PASS ] job 1 + buffered ok [ PLAN ] job 1 | Expected assertions: 1 job 1 ^ [ PLAN ] job 1 Expected assertions: 1 EOT like($out->{output}, qr{\Q$want\E}, "Got the desired output"); }, ); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-w/��������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020302� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-w/b.tx����������������������������������������������������0000644�0001750�0001750�00000000103�15012417054�021072� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!perl use Test2::V0; ok(!$^W,'-w should not leak'); done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-w/a.tx����������������������������������������������������0000644�0001750�0001750�00000000110�15012417054�021067� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!perl -w use Test2::V0; ok($^W,'-w should be honoured'); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/plugin/��������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020355� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/plugin/lib/����������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021123� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/plugin/lib/App/������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021643� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/plugin/lib/App/Yath/�������������������������������������������0000755�0001750�0001750�00000000000�15012417054�022550� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/plugin/lib/App/Yath/Plugin/������������������������������������0000755�0001750�0001750�00000000000�15012417054�024006� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/plugin/lib/App/Yath/Plugin/TestPlugin.pm�����������������������0000644�0001750�0001750�00000010370�15012417054�026443� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin::TestPlugin; use strict; use warnings; use Test2::Harness::Util::HashBase qw/-foo/; use Test2::Harness::Util::JSON qw/encode_json/; use Scalar::Util qw/blessed/; use parent 'App::Yath::Plugin'; print "TEST PLUGIN: Loaded Plugin\n"; sub duration_data { my $self = shift; print "TEST PLUGIN: duration_data\n"; return { 't/integration/plugin/a.tx' => 'short', 't/integration/plugin/b.tx' => 'medium', 't/integration/plugin/c.tx' => 'medium', 't/integration/plugin/d.tx' => 'medium', 't/integration/plugin/test.tx' => 'long', }; } sub get_coverage_tests { my $self = shift; my ($settings, $changes) = @_; my $stype = ref($settings); my $type = ref($changes); my $count = keys %$changes; print "TEST PLUGIN: get_coverage_tests($stype, $type($count))\n"; return [ 't/integration/plugin/a.tx', 't/integration/plugin/b.tx', 't/integration/plugin/c.tx', 't/integration/plugin/d.tx', 't/integration/plugin/test.tx', ]; } sub changed_files { my $self = shift; my ($settings) = @_; my $type = ref($settings); print "TEST PLUGIN: changed_files($type)\n"; return ( 't/integration/plugin/a.tx', 't/integration/plugin/b.tx', 't/integration/plugin/c.tx', 't/integration/plugin/d.tx', 't/integration/plugin/test.tx', ); } sub sort_files_2 { my $self = shift; my %params = @_; die "self is not an instance! ($self)" unless blessed($self); my $settings = $params{settings} or die "NO SETTINGS!"; my $files = $params{files}; my %rank = ( test => 1, c => 2, b => 3, a => 4, d => 5, ); my @files = sort { my $an = $a->file; my $bn = $b->file; $an =~ s/^.*\W(\w+)\.tx$/$1/; $bn =~ s/^.*\W(\w+)\.tx$/$1/; $rank{$an} <=> $rank{$bn}; } @$files; return @files; }; sub munge_files { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); print "TEST PLUGIN: munge_files\n"; return; } sub munge_search { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my ($search, $default_search) = @_; print "TEST PLUGIN: munge_search\n"; @$search = (); my $path = __FILE__; $path =~ s{lib.{1,2}App.{1,2}Yath.{1,2}Plugin.{1,2}TestPlugin\.pm$}{}g; @$default_search = ($path); return; } sub claim_file { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my ($file) = @_; print "TEST PLUGIN: claim_file $file\n"; if ($file =~ /\.tx/) { require Test2::Harness::TestFile; return Test2::Harness::TestFile->new(file => $file); } return; } sub inject_run_data { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my %params = @_; print "TEST PLUGIN: inject_run_data\n"; my $fields = $params{fields}; push @$fields => {name => 'test_plugin', details => 'foo', raw => 'bar', data => 'baz'}; return; } my $seen = 0; sub handle_event { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my ($event) = @_; print "TEST PLUGIN: handle_event\n" unless $seen++; if(my $run = $event->facet_data->{harness_run}) { print "FIELDS: " . encode_json($run->{fields}) . "\n"; } return; } sub finish { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my %args = @_; print "TEST PLUGIN: finish " . join(', ' => map { "$_ => " . (ref($args{$_}) || $args{$_} // '?') } sort keys %args) . "\n"; return; } sub setup { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my ($settings) = @_; print "TEST PLUGIN: setup " . ref($settings) . "\n"; $self->shellcall( $settings, 'testplug', $^X, '-e', 'print STDERR "STDERR WRITE\n"; print STDOUT "STDOUT WRITE\n";', ); return; } sub teardown { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my ($settings) = @_; print "TEST PLUGIN: teardown " . ref($settings) . "\n"; return; } 1; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/plugin/test.tx�������������������������������������������������0000644�0001750�0001750�00000000244�15012417054�021711� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(!$INC{'App/Yath/Plugin/TestPlugin.pm'}, "Plugin is not loaded for test processes"); is($ENV{T2_HARNESS_JOB_DURATION}, 'long'); done_testing(); ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/plugin/d.tx����������������������������������������������������0000644�0001750�0001750�00000000123�15012417054�021151� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1); is($ENV{T2_HARNESS_JOB_DURATION}, 'medium'); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/plugin/c.tx����������������������������������������������������0000644�0001750�0001750�00000000121�15012417054�021146� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1); is($ENV{T2_HARNESS_JOB_DURATION}, 'medium'); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/plugin/b.tx����������������������������������������������������0000644�0001750�0001750�00000000121�15012417054�021145� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1); is($ENV{T2_HARNESS_JOB_DURATION}, 'medium'); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/plugin/a.tx����������������������������������������������������0000644�0001750�0001750�00000000120�15012417054�021143� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1); is($ENV{T2_HARNESS_JOB_DURATION}, 'short'); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage4.t����������������������������������������������������0000644�0001750�0001750�00000021574�15012417054�021134� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Harness::Util::JSON qw/encode_json decode_json/; use Test2::Require::Module 'Test2::Plugin::Cover' => '0.000022'; use App::Yath::Tester qw/yath/; use File::Temp qw/tempfile/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; $dir =~ s/\d+$//; my ($fh, $logfile) = tempfile("yathlog-$$-XXXXXXXX", TMPDIR => 1, UNLINK => 1, SUFFIX => '.jsonl.bz2'); close($fh); yath( command => 'test', args => ["-I$dir/lib", $dir, '--ext=tx', '-v', '-B', '-F' => $logfile, '--cover-files', '--cover-agg' => 'ByTest'], exit => 0, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { 't/integration/coverage/a.tx' => {env => {COVER_TEST_SUBTESTS => 'a, b, c'}, stdin => "a\nb\nc\n", argv => ['a', 'b', 'c']}, 't/integration/coverage/c.tx' => {env => {COVER_TEST_SUBTESTS => 'a, c'}, stdin => "a\nc\n", argv => ['a', 'c']}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { # No manager, so run entire tests 't/integration/coverage/b.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/x.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/open.tx' => {argv => [], env => {}, stdin => ''}, # Managed, so we have custom input 't/integration/coverage/a.tx' => {'argv' => ['b', 'c'], 'env' => {'COVER_TEST_SUBTESTS' => 'b, c'}, 'stdin' => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bxb'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/b.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/open.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/x.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/a.tx" => {"argv" => ["b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "b, c"}, "stdin" => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cxc'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax*'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'AxCx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage3.t����������������������������������������������������0000644�0001750�0001750�00000021573�15012417054�021132� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Harness::Util::JSON qw/encode_json decode_json/; use Test2::Require::Module 'Test2::Plugin::Cover' => '0.000022'; use App::Yath::Tester qw/yath/; use File::Temp qw/tempfile/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; $dir =~ s/\d+$//; my ($fh, $logfile) = tempfile("yathlog-$$-XXXXXXXX", TMPDIR => 1, UNLINK => 1, SUFFIX => '.jsonl.bz2'); close($fh); yath( command => 'test', args => ["-I$dir/lib", $dir, '--ext=tx', '-v', '-B', '-F' => $logfile, '--cover-files', '--cover-agg' => 'ByRun'], exit => 0, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { 't/integration/coverage/a.tx' => {env => {COVER_TEST_SUBTESTS => 'a, b, c'}, stdin => "a\nb\nc\n", argv => ['a', 'b', 'c']}, 't/integration/coverage/c.tx' => {env => {COVER_TEST_SUBTESTS => 'a, c'}, stdin => "a\nc\n", argv => ['a', 'c']}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { # No manager, so run entire tests 't/integration/coverage/b.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/x.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/open.tx' => {argv => [], env => {}, stdin => ''}, # Managed, so we have custom input 't/integration/coverage/a.tx' => {'argv' => ['b', 'c'], 'env' => {'COVER_TEST_SUBTESTS' => 'b, c'}, 'stdin' => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bxb'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/b.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/open.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/x.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/a.tx" => {"argv" => ["b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "b, c"}, "stdin" => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cxc'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax*'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'AxCx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); done_testing; �������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage2.t����������������������������������������������������0000644�0001750�0001750�00000026412�15012417054�021126� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Harness::Util::JSON qw/encode_json decode_json/; use Test2::Require::Module 'Test2::Plugin::Cover' => '0.000022'; use App::Yath::Tester qw/yath/; use File::Temp qw/tempfile/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; $dir =~ s/\d+$//; my ($fh, $cfile) = tempfile(SUFFIX => '.jsonl'); close($fh); yath( command => 'test', args => ["-I$dir/lib", $dir, '--ext=tx', "--cover-write=$cfile", '-v'], exit => 0, ); my @coverage; open($fh, '<', $cfile); for my $line (<$fh>) { next unless $line; push @coverage => decode_json($line); } is( \@coverage, bag { item { 'test' => 't/integration/coverage/a.tx', 'manager' => 'Manager', 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByTest', 'files' => { 'Ax.pm' => { '*' => ['*'], 'a' => bag { item {'subtest' => 'b'}; item {'subtest' => 'c'}; item {'subtest' => 'a'} }, 'aa' => [{'subtest' => 'a'}], }, 'Bx.pm' => { 'b' => bag { item {'subtest' => 'b'}; item {'subtest' => 'c'} }, '*' => ['*'], }, 'Cx.pm' => { 'c' => bag { item '*'; item {'subtest' => 'c'} }, '*' => ['*'], }, }, }; item { 'test' => 't/integration/coverage/b.tx', 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByTest', 'files' => { 'Bx.pm' => { 'b' => ['*'], '*' => ['*'], }, }, }; item { 'test' => 't/integration/coverage/c.tx', 'manager' => 'Manager', 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByTest', 'files' => { 'Ax.pm' => { 'a' => bag { item {'subtest' => 'c'}; item {'subtest' => 'a'} }, '*' => [{'subtest' => 'a'}], }, 'Cx.pm' => { 'c' => [{'subtest' => 'c'}], '*' => [{'subtest' => 'c'}], } } }; item { 'test' => 't/integration/coverage/once.tx', 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByTest', 'files' => {}, }; item { 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByTest', 'test' => 't/integration/coverage/open.tx', 'files' => {'Bx.pm' => {'<>' => ['*']}}, }; item { 'test' => 't/integration/coverage/x.tx', 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByTest', 'files' => {'Bx.pm' => {'*' => ['*']}}, }; }, "Got predicted coverage data", ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { 't/integration/coverage/a.tx' => {env => {COVER_TEST_SUBTESTS => 'a, b, c'}, stdin => "a\nb\nc\n", argv => ['a', 'b', 'c']}, 't/integration/coverage/c.tx' => {env => {COVER_TEST_SUBTESTS => 'a, c'}, stdin => "a\nc\n", argv => ['a', 'c']}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { # No manager, so run entire tests 't/integration/coverage/b.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/x.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/open.tx' => {argv => [], env => {}, stdin => ''}, # Managed, so we have custom input 't/integration/coverage/a.tx' => {'argv' => ['b', 'c'], 'env' => {'COVER_TEST_SUBTESTS' => 'b, c'}, 'stdin' => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bxb'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/b.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/open.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/x.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/a.tx" => {"argv" => ["b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "b, c"}, "stdin" => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cxc'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax*'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'AxCx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/speedtag.t�����������������������������������������������������0000644�0001750�0001750�00000002506�15012417054�021043� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use File::Copy qw/copy/; use Test2::Harness::Util::File::JSONL; use App::Yath::Tester qw/yath/; use App::Yath::Util qw/find_yath/; find_yath(); # cache result before we chdir my $tmp = tempdir(CLEANUP => 1); my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my $pass = File::Spec->catfile($tmp, 'pass.tx'); my $pass2 = File::Spec->catfile($tmp, 'pass2.tx'); copy(File::Spec->catfile($dir, 'pass.tx'), $pass); copy(File::Spec->catfile($dir, 'pass2.tx'), $pass2); my $out = yath(command => 'test', args => [$tmp, '--ext=tx'], log => 1, exit => 0); my $log = $out->{log}->name; yath( command => 'speedtag', args => [$log], exit => 0, test => sub { like($_, qr/Tagged .*pass\.tx/, "Indicate we tagged pass"); like($_, qr/Tagged .*pass2\.tx/, "Indicate we tagged pass2"); for my $file ($pass, $pass2) { open(my $fh, '<', $file) or die $!; my $found = 0; while (my $line = <$fh>) { chomp($line); next unless $line =~ m/^#\s*HARNESS-DURATION-(SHORT|MEDIUM|LONG)$/; $found = 1; last; } $file =~ s/^.*(pass\d?\.tx)$/$1/; ok($found, "Tagged file $file"); } }, ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/smoke/���������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020175� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/smoke/lib/�����������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020743� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/smoke/lib/SmokePlugin.pm���������������������������������������0000644�0001750�0001750�00000000425�15012417054�023537� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package SmokePlugin; use strict; use warnings; use parent 'App::Yath::Plugin'; sub munge_files { my $self = shift; my ($tests, $settings) = @_; for my $test (@$tests) { next unless $test->relative =~ m/[aceg]\.tx$/; $test->set_smoke; } } 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/smoke/h.tx�����������������������������������������������������0000644�0001750�0001750�00000000057�15012417054�021003� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/smoke/g.tx�����������������������������������������������������0000644�0001750�0001750�00000000057�15012417054�021002� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/smoke/f.tx�����������������������������������������������������0000644�0001750�0001750�00000000057�15012417054�021001� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/smoke/e.tx�����������������������������������������������������0000644�0001750�0001750�00000000057�15012417054�021000� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/smoke/d.tx�����������������������������������������������������0000644�0001750�0001750�00000000057�15012417054�020777� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/smoke/c.tx�����������������������������������������������������0000644�0001750�0001750�00000000057�15012417054�020776� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/smoke/b.tx�����������������������������������������������������0000644�0001750�0001750�00000000057�15012417054�020775� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/smoke/a.tx�����������������������������������������������������0000644�0001750�0001750�00000000056�15012417054�020773� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/resource.t�����������������������������������������������������0000644�0001750�0001750�00000005172�15012417054�021100� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', args => [$dir, '--ext=tx', '-j4', "-D$dir", '-R+Resource'], log => 1, exit => 0, test => sub { my $out = shift; my $log = $out->{log}; my @events = $log->poll(); my %pids; my %msgs; for my $event (@events) { my $f = $event->{facet_data}; my $info = $f->{info} or next; for my $i (@$info) { next unless $i->{tag} eq 'INTERNAL'; if ($i->{details} =~ m/^(\S+) - (yath-\S+)$/) { $pids{$1} = $2; next; } next unless $i->{details} =~ m/^(\S+) - (?:(\S+): \S+ - (\d)|(.+))$/; my ($pid, $action, $res_id) = ($1, ($2 || $4), $3); $pid = $pids{$pid} // $pid; if ($res_id) { push @{$msgs{$pid}->{$res_id}} => $action; } else { push @{$msgs{$pid}->{$_}} => $action for keys %{$msgs{$pid}}; } } } is( $msgs{"yath-nested-runner"}, { 1 => [ 'Record', 'Release', 'Record', 'Release', 'RESOURCE CLEANUP', ], 2 => [ 'Record', 'Release', 'Record', 'Release', 'RESOURCE CLEANUP', ], }, "The nested runner saw the records and releases, and then cleaned up at the end." ); is( $msgs{'yath-nested-scheduler'}, { 1 => [ 'Assigned', 'Record', 'No Slots', 'Release', 'Assigned', 'Record', 'Release', ], 2 => [ 'Assigned', 'Record', 'No Slots', 'Release', 'Assigned', 'Record', 'Release', ], }, "The scheduler handled assigning slots, knew when it was out, then knew when more were ready", ); }, ); done_testing; 1; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/projects.t�����������������������������������������������������0000644�0001750�0001750�00000004532�15012417054�021101� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Util qw/find_yath/; find_yath(); # cache result before we chdir use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my $out; yath( command => 'projects', args => ['--ext=tx', '--', $dir], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{PASSED .*foo.*t.*pass\.tx}, "Found pass.tx in foo project"); like($out->{output}, qr{PASSED .*bar.*t.*pass\.tx}, "Found pass.tx in bar project"); like($out->{output}, qr{PASSED .*baz.*t.*pass\.tx}, "Found pass.tx in baz project"); unlike($out->{output}, qr{fail\.txx}, "Did not run fail.txx"); }, ); yath( command => 'projects', args => ['--ext=tx', '--ext=txx', '--', $dir], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{PASSED .*foo.*t.*pass\.tx}, "Found pass.tx in foo project"); like($out->{output}, qr{PASSED .*bar.*t.*pass\.tx}, "Found pass.tx in bar project"); like($out->{output}, qr{PASSED .*baz.*t.*pass\.tx}, "Found pass.tx in baz project"); like($out->{output}, qr{FAILED .*baz.*t.*fail\.txx}, "ran fail.txx"); }, ); chdir($dir); yath( command => 'projects', args => ['--ext=tx', '-v'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{PASSED .*foo.*t.*pass\.tx}, "Found pass.tx in foo project"); like($out->{output}, qr{PASSED .*bar.*t.*pass\.tx}, "Found pass.tx in bar project"); like($out->{output}, qr{PASSED .*baz.*t.*pass\.tx}, "Found pass.tx in baz project"); unlike($out->{output}, qr{fail\.txx}, "Did not run fail.txx"); }, ); yath( command => 'projects', args => ['--ext=tx', '--ext=txx'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{PASSED .*foo.*t.*pass\.tx}, "Found pass.tx in foo project"); like($out->{output}, qr{PASSED .*bar.*t.*pass\.tx}, "Found pass.tx in bar project"); like($out->{output}, qr{PASSED .*baz.*t.*pass\.tx}, "Found pass.tx in baz project"); like($out->{output}, qr{FAILED .*baz.*t.*fail\.txx}, "ran fail.txx"); }, ); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/includes.t�����������������������������������������������������0000644�0001750�0001750�00000001675�15012417054�021063� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use IPC::Cmd qw/can_run/; use File::Spec; use App::Yath::Tester qw/yath/; use App::Yath::Util qw/find_yath/; find_yath(); # cache result before we chdir my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; chdir($dir); $ENV{OLD_PERL5LIB} = $ENV{PERL5LIB}; yath( command => 'test', args => ['default.tx'], exit => 0, ); yath( command => 'test', args => ['-Ixyz', 'default-i.tx'], exit => 0, ); yath( command => 'test', args => ['-Ia', '-b', '-Ib', '-l', '-Ic', 'order-ibili.tx'], exit => 0, ); yath( command => 'test', args => ['-Ia', '-l', '-Ib', '-b', '-Ic', 'order-ilibi.tx'], exit => 0, ); yath( command => 'test', args => ['-Ixyz', '--unsafe-inc', 'dot-last.tx'], exit => 0, ); $ENV{YATH_PERL} = $^X; yath( command => 'test', args => ['-Ixyz', './not-perl.sh'], exit => 0, ) if can_run('bash'); done_testing; �������������������������������������������������������������������Test2-Harness-1.000158/t/integration/encoding.t�����������������������������������������������������0000644�0001750�0001750�00000003312�15012417054�021031� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use App::Yath::Tester qw/yath/; use File::Temp qw/tempdir/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my $want = <<"EOT"; ( NOTE ) job 1 valid note [\x{201c}\x{201d}\x{ff}\x{ff}] ( NOTE ) job 1 valid note [\x{201c}\x{201d}] ( DIAG ) job 1 valid diag [\x{201c}\x{201d}\x{ff}\x{ff}] ( DIAG ) job 1 valid diag [\x{201c}\x{201d}] ( STDOUT ) job 1 valid stdout [\x{201c}\x{201d}\x{ff}\x{ff}] ( STDOUT ) job 1 valid stdout [\x{201c}\x{201d}] ( STDERR ) job 1 valid stderr [\x{201c}\x{201d}\x{ff}\x{ff}] ( STDERR ) job 1 valid stderr [\x{201c}\x{201d}] [ PASS ] job 1 + valid ok [\x{201c}\x{201d}\x{ff}\x{ff}] [ PASS ] job 1 + valid ok [\x{201c}\x{201d}] ( STDOUT ) job 1 STDOUT: M\x{101}kaha ( STDERR ) job 1 STDERR: M\x{101}kaha ( DIAG ) job 1 DIAG: M\x{101}kaha ( NOTE ) job 1 NOTE: M\x{101}kaha [ PASS ] job 1 + ASSERT: M\x{101}kaha [ PASS ] job 1 + \x{406} \x{449}\x{435} \x{442}\x{440}\x{43e}\x{445}\x{438} EOT yath( command => 'test', args => ['-v', "$dir/plugin.tx"], exit => 0, encoding => 'utf8', test => sub { my $out = shift; like($out->{output}, qr/\Q$want\E/, "Got proper codepoints"); }, ); yath( command => 'test', args => ['-v', "$dir/no-plugin.tx"], exit => 0, test => sub { my $out = shift; utf8::encode( my $raw_want = $want ); utf8::encode( my $u00ff = "\x{ff}" ); $raw_want =~ s<\Q$u00ff\E><\xff>g; like($out->{output}, qr/\Q$raw_want\E/, "Got proper codepoints"); }, ); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/coverage.t�����������������������������������������������������0000644�0001750�0001750�00000032332�15012417054�021042� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Harness::Util::JSON qw/encode_json decode_json/; use Test2::Require::Module 'Test2::Plugin::Cover' => '0.000022'; use App::Yath::Tester qw/yath/; use File::Temp qw/tempfile/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my ($fh, $cfile) = tempfile(SUFFIX => '.json'); close($fh); yath( command => 'test', args => ["-I$dir/lib", $dir, '--ext=tx', "--cover-write=$cfile", '-v'], exit => 0, ); open($fh, '<', $cfile); my $json = join '' => <$fh>; my $coverage = decode_json($json); is( $coverage, { 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByRun', 'testmeta' => { 't/integration/coverage/a.tx' => {'manager' => 'Manager', 'type' => 'split'}, 't/integration/coverage/b.tx' => {'type' => 'flat'}, 't/integration/coverage/c.tx' => {'manager' => 'Manager', 'type' => 'split'}, 't/integration/coverage/once.tx' => {'type' => 'flat'}, 't/integration/coverage/open.tx' => {'type' => 'flat'}, 't/integration/coverage/x.tx' => {'type' => 'flat'}, }, 'files' => { 'Ax.pm' => { '*' => { 't/integration/coverage/a.tx' => ['*'], 't/integration/coverage/c.tx' => [{'subtest' => 'a'}], }, 'a' => { 't/integration/coverage/a.tx' => bag { item {'subtest' => 'c'}; item {'subtest' => 'b'}; item {'subtest' => 'a'}; end; }, 't/integration/coverage/c.tx' => bag { item {'subtest' => 'c'}; item {'subtest' => 'a'}; end; }, }, 'aa' => {'t/integration/coverage/a.tx' => [{'subtest' => 'a'}]}, }, 'Bx.pm' => { '*' => { 't/integration/coverage/a.tx' => ['*'], 't/integration/coverage/b.tx' => ['*'], 't/integration/coverage/x.tx' => ['*'], }, '<>' => {'t/integration/coverage/open.tx' => ['*']}, 'b' => { 't/integration/coverage/a.tx' => bag { item {'subtest' => 'c'}; item {'subtest' => 'b'}; end; }, 't/integration/coverage/b.tx' => ['*'], }, }, 'Cx.pm' => { '*' => { 't/integration/coverage/a.tx' => ['*'], 't/integration/coverage/c.tx' => [{'subtest' => 'c'}], }, 'c' => { 't/integration/coverage/a.tx' => [ '*', {'subtest' => 'c'}, ], 't/integration/coverage/c.tx' => [{'subtest' => 'c'}] }, }, }, }, "Got predicted coverage data", ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { 't/integration/coverage/a.tx' => {env => {COVER_TEST_SUBTESTS => 'a, b, c'}, stdin => "a\nb\nc\n", argv => ['a', 'b', 'c']}, 't/integration/coverage/c.tx' => {env => {COVER_TEST_SUBTESTS => 'a, c'}, stdin => "a\nc\n", argv => ['a', 'c']}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { # No manager, so run entire tests 't/integration/coverage/b.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/x.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/open.tx' => {argv => [], env => {}, stdin => ''}, # Managed, so we have custom input 't/integration/coverage/a.tx' => {'argv' => ['b', 'c'], 'env' => {'COVER_TEST_SUBTESTS' => 'b, c'}, 'stdin' => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bxb'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/b.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/open.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/x.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/a.tx" => {"argv" => ["b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "b, c"}, "stdin" => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cxc'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax*'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'AxCx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); # Add some tests that do not exist, coverage testing shoudl warn and should skip them. $coverage->{testmeta}->{'t/integration/coverage/mia1.tx'} = $coverage->{testmeta}->{'t/integration/coverage/a.tx'}; $coverage->{testmeta}->{'t/integration/coverage/mia2.tx'} = $coverage->{testmeta}->{'t/integration/coverage/b.tx'}; $coverage->{files}->{'Ax.pm'}->{'*'}->{'t/integration/coverage/mia1.tx'} = ['*']; $coverage->{files}->{'Ax.pm'}->{'*'}->{'t/integration/coverage/mia2.tx'} = ['*']; open($fh, '>', $cfile) or die "Could not open file: $!"; my $njson = encode_json($coverage); print $fh $njson; close($fh); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { 't/integration/coverage/a.tx' => {env => {COVER_TEST_SUBTESTS => 'a, b, c'}, stdin => "a\nb\nc\n", argv => ['a', 'b', 'c']}, 't/integration/coverage/c.tx' => {env => {COVER_TEST_SUBTESTS => 'a, c'}, stdin => "a\nc\n", argv => ['a', 'c']}, }, "Test got the correct input about what subtests to run", ); like( $out->{output}, qr{Coverage wants to run test 't/integration/coverage/mia1\.tx', but it does not exist, skipping\.\.\.}, "Skipped mia1 because it does not exist", ); like( $out->{output}, qr{Coverage wants to run test 't/integration/coverage/mia2\.tx', but it does not exist, skipping\.\.\.}, "Skipped mia2 because it does not exist", ); }, ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/signals.t������������������������������������������������������0000644�0001750�0001750�00000001052�15012417054�020702� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Require::AuthorTesting; use File::Temp qw/tempdir/; use File::Spec; use Test2::Harness::Util::File::JSONL; use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; for ( 1..10 ) { # the tests are flapping when using something like '%INC = %INC'.... # make sure the issue is fixed by running them a few times my $out = yath( prefix => "Try $_: ", command => 'test', args => [$dir], log => 0, exit => 0, ); } done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/preload.t������������������������������������������������������0000644�0001750�0001750�00000012155�15012417054�020676� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Util qw/CAN_REALLY_FORK/; skip_all "Cannot fork, skipping preload test" unless CAN_REALLY_FORK; skip_all "This test requires forking" if $ENV{T2_NO_FORK}; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', args => [$dir, '--ext=tx', '-A', '-PTestSimplePreload', '-PTestPreload'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{PASSED.*no_preload\.tx}, 'Ran file "no_preload.tx"'); like($out->{output}, qr{PASSED.*aaa\.tx}, 'Ran file "aaa.tx"'); like($out->{output}, qr{PASSED.*bbb\.tx}, 'Ran file "bbb.tx"'); like($out->{output}, qr{PASSED.*ccc\.tx}, 'Ran file "ccc.tx"'); like($out->{output}, qr{PASSED.*simple_test\.tx}, 'Ran file "simple_test.tx"'); like($out->{output}, qr{PASSED.*preload_test\.tx}, 'Ran file "preload_test.tx"'); like($out->{output}, qr{PASSED.*fast\.tx}, 'Ran file "fast.tx"'); like($out->{output}, qr{PASSED.*slow\.tx}, 'Ran file "slow.tx"'); like($out->{output}, qr{TO RETRY.*retry\.tx}, 'Ran file "retry.tx" with a failure'); like($out->{output}, qr{PASSED.*retry\.tx}, 'Ran file "retry.tx" again with a pass'); }, ); yath( command => 'test', args => [$dir, '--ext=tx', '-A', '-PTestSimplePreload', '-PTestPreload', '-PBroken'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{This is broken}, "Reported the error"); like($out->{output}, qr{No tests were seen!}, "No tests were run"); }, ); yath( command => 'test', args => [$dir, '--ext=tx', '-A', '-PTestBadPreload' ], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{Child stage 'BAD' did not exit cleanly}, "Reported the error"); }, ); unless ($ENV{AUTOMATED_TESTING}) { yath( command => 'start', args => ['-PTestSimplePreload', '-PTestPreload'], exit => 0, test => sub { yath( command => 'run', args => [$dir, '--ext=tx', '-A'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{PASSED.*no_preload\.tx}, 'Ran file "no_preload.tx"'); like($out->{output}, qr{PASSED.*aaa\.tx}, 'Ran file "aaa.tx"'); like($out->{output}, qr{PASSED.*bbb\.tx}, 'Ran file "bbb.tx"'); like($out->{output}, qr{PASSED.*ccc\.tx}, 'Ran file "ccc.tx"'); like($out->{output}, qr{PASSED.*simple_test\.tx}, 'Ran file "simple_test.tx"'); like($out->{output}, qr{PASSED.*preload_test\.tx}, 'Ran file "preload_test.tx"'); like($out->{output}, qr{PASSED.*fast\.tx}, 'Ran file "fast.tx"'); like($out->{output}, qr{PASSED.*slow\.tx}, 'Ran file "slow.tx"'); like($out->{output}, qr{TO RETRY.*retry\.tx}, 'Ran file "retry.tx" with a failure'); like($out->{output}, qr{PASSED.*retry\.tx}, 'Ran file "retry.tx" again with a pass'); }, ); yath(command => 'stop', exit => 0); }, ); # Persistent mode ignored broken preloads as they may be under active development yath( command => 'start', args => ['-PTestSimplePreload', '-PTestPreload', '-PBroken'], exit => 0, test => sub { yath( command => 'run', args => [$dir, '--ext=tx', '-A'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{This is broken}, "Reported the error"); like($out->{output}, qr{PASSED.*no_preload\.tx}, 'Ran file "no_preload.tx"'); like($out->{output}, qr{PASSED.*aaa\.tx}, 'Ran file "aaa.tx"'); like($out->{output}, qr{PASSED.*bbb\.tx}, 'Ran file "bbb.tx"'); like($out->{output}, qr{PASSED.*ccc\.tx}, 'Ran file "ccc.tx"'); like($out->{output}, qr{PASSED.*simple_test\.tx}, 'Ran file "simple_test.tx"'); like($out->{output}, qr{PASSED.*preload_test\.tx}, 'Ran file "preload_test.tx"'); like($out->{output}, qr{PASSED.*fast\.tx}, 'Ran file "fast.tx"'); like($out->{output}, qr{PASSED.*slow\.tx}, 'Ran file "slow.tx"'); like($out->{output}, qr{TO RETRY.*retry\.tx}, 'Ran file "retry.tx" with a failure'); like($out->{output}, qr{PASSED.*retry\.tx}, 'Ran file "retry.tx" again with a pass'); }, ); yath(command => 'stop', exit => 0); }, ); } done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/persist.t������������������������������������������������������0000644�0001750�0001750�00000005006�15012417054�020736� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; skip_all "This test is not run under automated testing" if $ENV{AUTOMATED_TESTING}; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath(command => 'start', exit => 0); yath( command => 'run', args => [$dir, '--ext=tx', '--ext=txx'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the output"); like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); yath( command => 'run', args => [$dir, '--ext=tx'], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr{fail\.tx}, "'fail.tx' was not seen when reading the output"); like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); yath( command => 'which', exit => 0, test => sub { my $out = shift; like($out->{output}, qr/^\s*Found: .*yath-persist\.json$/m, "Found the persist file"); like($out->{output}, qr/^\s*PID: /m, "Found the PID"); like($out->{output}, qr/^\s*Dir: /m, "Found the Dir"); }, ); yath(command => 'reload', exit => 0); yath( command => 'watch', args => ['STOP'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{yath-nested-runner \(default\) Runner caught SIGHUP, reloading}, "Reloaded runner"); }, ); yath( command => 'run', args => [$dir, '--ext=txx'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the output"); unlike($out->{output}, qr{pass\.tx}, "'pass.tx' was not seen when reading the output"); }, ); yath( command => 'run', args => [$dir, '-vvv'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr/No tests were seen!/, "Got error message"); }, ); yath(command => 'stop', exit => 0); yath( command => 'which', exit => 0, test => sub { my $out = shift; like($out->{output}, qr/No persistent harness was found for the current path\./, "No active runner"); }, ); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/log_dir.t������������������������������������������������������0000644�0001750�0001750�00000001370�15012417054�020664� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use App::Yath::Tester qw/yath/; use File::Temp qw/tempdir/; use File::Spec; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my $tmpdir = tempdir(CLEANUP => 1); yath( command => 'test', args => ["--log-dir=$tmpdir", '-L', '--ext=tx', $dir], exit => 0, test => sub { my $out = shift; opendir(my $dh, $tmpdir) or die "Could not open dir $tmpdir: $!"; my @files; for my $file (readdir($dh)) { next if $file =~ m/^\.+$/; next unless -f File::Spec->catfile($tmpdir, $file); push @files => $file; } is(@files, 1, "Only 1 file present"); like($files[0], qr{\.jsonl$}, "File is a jsonl file"); }, ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test-w.t�������������������������������������������������������0000644�0001750�0001750�00000000765�15012417054�020477� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; # assert that, regardless of order, the `perl -w` shebang only applies # to the test file it appears in; see # https://github.com/Test-More/Test2-Harness/issues/266 yath( command => 'test', args => ["$dir/a.tx", "$dir/b.tx", '--ext=tx'], exit => 0, ); yath( command => 'test', args => ["$dir/b.tx", "$dir/a.tx", '--ext=tx'], exit => 0, ); done_testing; �����������Test2-Harness-1.000158/t/integration/stamps.t�������������������������������������������������������0000644�0001750�0001750�00000001237�15012417054�020556� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', args => [$dir, '--ext=tx', '-A', '--no-plugins', '-pTestPlugin', '-v'], exit => T(), log => 1, test => sub { my $out = shift; while (my @events = $out->{log}->poll()) { for my $event (@events) { last unless $event; ok($event->{stamp}, "Event had a timestamp"); } } }, ); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/replay.t�������������������������������������������������������0000644�0001750�0001750�00000002673�15012417054�020550� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; sub clean_output { my $out = shift; $out->{output} =~ s/^.*duration.*$//m; $out->{output} =~ s/^.*Wrote log file:.*$//m; $out->{output} =~ s/^.*Symlinked to:.*$//m; $out->{output} =~ s/^\s*Wall Time:.*seconds//m; $out->{output} =~ s/^\s*CPU Time:.*s\)//m; $out->{output} =~ s/^\s*CPU Usage:.*%//m; $out->{output} =~ s/^\s*-+$//m; $out->{output} =~ s/^\s+$//m; $out->{output} =~ s/\n+/\n/g; $out->{output} =~ s/^\s+//mg; } 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 $logfile = $out1->{log}->name; 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"); }, ); done_testing; ���������������������������������������������������������������������Test2-Harness-1.000158/t/integration/reload.t�������������������������������������������������������0000644�0001750�0001750�00000056300�15012417054�020516� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util qw/clean_path/; use Test2::Harness::Util::JSON qw/decode_json/; skip_all "This test is not run under automated testing" if $ENV{AUTOMATED_TESTING}; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my $fqdir = clean_path($dir); my $pdir = $fqdir; $pdir =~ s{\W{0,2}t\W{1,2}integration\W{1,2}reload$}{}g; my $tmpdir = tempdir(CLEANUP => 1); mkdir("$tmpdir/Preload") or die "($tmpdir/Preload) $!"; sub touch_files { note "About to touch files with a delay between each, this will take a while"; for my $file (qw/A B A B ExceptionA ExceptionB WarningA WarningB ExporterA ExporterB IncChange Churn nonperl1 nonperl2/) { my $path = "$dir/lib/Preload/${file}"; $path .= '.pm' unless $file =~ m/nonperl/; note "Touching $file..."; sleep 2; if ($file eq 'IncChange') { open(my $fh, '>', "$tmpdir/Preload/IncChange.pm") or die $!; print $fh <<' EOT'; package Preload::IncChange; use strict; use warnings; BEGIN { print "$$ $0 Loaded (DIFFERENT) ${ \__PACKAGE__ }\n"; } 1; EOT close($fh); } utime(undef, undef, $path); } sleep 2; } sub parse_output { my ($output) = @_; # On macOS, these days, /var is actually a symlink to /private/var. # Somewhere along the lines, something is turning /var into /private/var in # the runner, which makes the "strip out the tmpdir" code (marked below) # leave behind a /private. This fix is inelegant, but probably fixes the # overwhelming majority of macOS test failures without introducing any # further problems. A better fix might be to track down and eliminate the # rewriting of the path, or to uniformly make this check match the behavior # under the hood. For now: let's just let macOS users install # TAP2::Harness! -- rjbs, 2022-02-20 my $safe_tmpdir = $tmpdir; if ($safe_tmpdir =~ m{\A/var/} && -l '/var') { my $target = File::Spec->rel2abs(readlink('/var'), '/'); $target =~ s{/\z}{}; $safe_tmpdir =~ s{\A/var}{$target}; } my %by_proc; for my $line (split /\n/, $output) { next unless $line =~ m/^\s*(\d+) yath-nested-runner(?:-(\S+))? - (.+)$/; my ($pid, $proc, $text) = ($1, $2, $3); $proc //= ''; $text =~ s/$pid yath-nested-runner-$proc(\s*-\s*)//g; $text =~ s{(\Q$fqdir\E|\Q$dir\E|\Q$pdir\E)/*}{}g; $text =~ s{\Q$safe_tmpdir\E(/)?}{TEMP$1}g; # <-- strip out the tmpdir $text =~ s{ line \d+.*$}{}g; push @{$by_proc{$proc || 'default'}} => $text; } return \%by_proc; } subtest no_in_place => sub { unlink("$tmpdir/Preload/IncChange.pm") if -e "$tmpdir/Preload/IncChange.pm"; yath( command => 'start', args => ['-PPreload'], pre => ["-D$tmpdir"], exit => 0, ); touch_files(); yath( command => 'watch', args => ['STOP'], exit => 0, test => sub { my $out = shift; my $parsed = parse_output($out->{output}); is( $parsed, { 'default' => [ 'Loaded Preload', ], 'A' => [ 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/A.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::A...', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExceptionA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExceptionA...', 'Loaded Preload::WarningA', 'Loaded Preload::ExporterA', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/WarningA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::WarningA...', 'Loaded Preload::ExporterA', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExporterA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExporterA...', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/Churn.pm\'...', 'Changed file \'Preload/Churn.pm\' contains churn sections, running them instead of a full reload...', 'Churn 1', 'FOO: foo 2', 'Success reloading churn block (lib/Preload/Churn.pm lines 8 -> 16)', 'Churn 2', 'Success reloading churn block (lib/Preload/Churn.pm lines 18 -> 20)', 'Error reloading churn block (lib/Preload/Churn.pm lines 22 -> 28): Died on count 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/nonperl1\'...', 'Changed file \'lib/Preload/nonperl1\' has a reload callback, executing it instead of regular reloading...', 'RELOAD CALLBACK nonperl1', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/nonperl2\'...', 'Changed file \'lib/Preload/nonperl2\' has a reload callback, executing it instead of regular reloading...', 'RELOAD CALLBACK nonperl2', ], 'B' => [ 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Loaded Preload::B', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/A.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::A...', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Loaded Preload::B', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/B.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::B...', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExceptionA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExceptionA...', 'Loaded Preload::WarningA', 'Loaded Preload::ExporterA', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExceptionB.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExceptionB...', 'Loaded Preload::WarningA', 'Loaded Preload::ExporterA', 'Loaded Preload::WarningB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/WarningA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::WarningA...', 'Loaded Preload::ExporterA', 'Loaded Preload::WarningB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/WarningB.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::WarningB...', 'Loaded Preload::ExporterA', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExporterA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExporterA...', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExporterB.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExporterB...', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/IncChange.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::IncChange...', ], }, "Reload happened as expected", ); }, ); yath(command => 'stop', exit => 0); }; subtest in_place => sub { unlink("$tmpdir/Preload/IncChange.pm") if -e "$tmpdir/Preload/IncChange.pm"; yath( command => 'start', args => ['-PPreload', '-r'], pre => ["-D$tmpdir"], exit => 0, ); touch_files(); yath( command => 'watch', args => ['STOP'], exit => 0, test => sub { my $out = shift; my $parsed = parse_output($out->{output}); is( $parsed, { 'default' => [ 'Loaded Preload', ], 'A' => [ 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/A.pm\'...', 'Runner attempting to reload \'lib/Preload/A.pm\' in place...', 'Loaded Preload::A', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/A.pm\'...', 'Runner attempting to reload \'lib/Preload/A.pm\' in place...', 'Loaded Preload::A', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExceptionA.pm\'...', 'Runner attempting to reload \'lib/Preload/ExceptionA.pm\' in place...', 'Loaded Preload::ExceptionA', 'Runner failed to reload \'lib/Preload/ExceptionA.pm\' in place...', 'Loaded Preload::ExceptionA again.', 'BEGIN failed--compilation aborted at lib/Preload/ExceptionA.pm', 'Compilation failed in require at lib/Test2/Harness/Runner/Reloader.pm', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/WarningA.pm\'...', 'Runner attempting to reload \'lib/Preload/WarningA.pm\' in place...', 'Loaded Preload::WarningA', 'Runner failed to reload \'lib/Preload/WarningA.pm\' in place...', 'Loaded Preload::WarningA again.', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExporterA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExporterA...', 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/Churn.pm\'...', 'Changed file \'Preload/Churn.pm\' contains churn sections, running them instead of a full reload...', 'Churn 1', 'FOO: foo 2', 'Success reloading churn block (lib/Preload/Churn.pm lines 8 -> 16)', 'Churn 2', 'Success reloading churn block (lib/Preload/Churn.pm lines 18 -> 20)', 'Error reloading churn block (lib/Preload/Churn.pm lines 22 -> 28): Died on count 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/nonperl1\'...', 'Changed file \'lib/Preload/nonperl1\' has a reload callback, executing it instead of regular reloading...', 'RELOAD CALLBACK nonperl1', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/nonperl2\'...', 'Changed file \'lib/Preload/nonperl2\' has a reload callback, executing it instead of regular reloading...', 'RELOAD CALLBACK nonperl2' ], 'B' => [ 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Loaded Preload::B', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/A.pm\'...', 'Runner attempting to reload \'lib/Preload/A.pm\' in place...', 'Loaded Preload::A', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/B.pm\'...', 'Runner attempting to reload \'lib/Preload/B.pm\' in place...', 'Loaded Preload::B', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/A.pm\'...', 'Runner attempting to reload \'lib/Preload/A.pm\' in place...', 'Loaded Preload::A', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/B.pm\'...', 'Runner attempting to reload \'lib/Preload/B.pm\' in place...', 'Loaded Preload::B', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExceptionA.pm\'...', 'Runner attempting to reload \'lib/Preload/ExceptionA.pm\' in place...', 'Loaded Preload::ExceptionA', 'Runner failed to reload \'lib/Preload/ExceptionA.pm\' in place...', 'Loaded Preload::ExceptionA again.', 'BEGIN failed--compilation aborted at lib/Preload/ExceptionA.pm', 'Compilation failed in require at lib/Test2/Harness/Runner/Reloader.pm', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExceptionB.pm\'...', 'Runner attempting to reload \'lib/Preload/ExceptionB.pm\' in place...', 'Loaded Preload::ExceptionB', 'Runner failed to reload \'lib/Preload/ExceptionB.pm\' in place...', 'Loaded Preload::ExceptionB again.', 'BEGIN failed--compilation aborted at lib/Preload/ExceptionB.pm', 'Compilation failed in require at lib/Test2/Harness/Runner/Reloader.pm', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/WarningA.pm\'...', 'Runner attempting to reload \'lib/Preload/WarningA.pm\' in place...', 'Loaded Preload::WarningA', 'Runner failed to reload \'lib/Preload/WarningA.pm\' in place...', 'Loaded Preload::WarningA again.', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/WarningB.pm\'...', 'Runner attempting to reload \'lib/Preload/WarningB.pm\' in place...', 'Loaded Preload::WarningB', 'Runner failed to reload \'lib/Preload/WarningB.pm\' in place...', 'Loaded Preload::WarningB again.', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExporterA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExporterA...', 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::B', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExporterB.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExporterB...', 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::B', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/IncChange.pm\'...', 'Runner attempting to reload \'lib/Preload/IncChange.pm\' in place...', 'Runner failed to reload \'lib/Preload/IncChange.pm\' in place...', 'Reloading \'Preload/IncChange.pm\' loaded \'TEMP/Preload/IncChange.pm\' instead of \'lib/Preload/IncChange.pm\', @INC must have been altered at lib/Test2/Harness/Runner/Reloader.pm' ], }, "Reload happened as expected", ); }, ); yath(command => 'stop', exit => 0); }; done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/plugin.t�������������������������������������������������������0000644�0001750�0001750�00000006447�15012417054�020555� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use App::Yath::Tester qw/yath/; use File::Temp qw/tempdir/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; sub verify { my (@outputs) = @_; my $text = ''; for my $out (@outputs) { $text .= $out->{output}; } like($text, qr/TEST PLUGIN: Loaded Plugin/, "Yath loaded the plugin"); like($text, qr/TEST PLUGIN: duration_data/, "duration_data() was called"); like($text, qr/TEST PLUGIN: changed_files\(Test2::Harness::Settings\)/, "changed_files() was called"); like($text, qr/TEST PLUGIN: get_coverage_tests\(Test2::Harness::Settings, HASH\(5\)\)/, "get_coverage_tests() was called"); like($text, qr/TEST PLUGIN: munge_files/, "munge_files() was called"); like($text, qr/TEST PLUGIN: munge_search/, "munge_search() was called"); like($text, qr/TEST PLUGIN: inject_run_data/, "inject_run_data() was called"); like($text, qr/TEST PLUGIN: handle_event/, "handle_event() was called"); like($text, qr/TEST PLUGIN: claim_file .*test\.tx$/m, "claim_file(test.tx) was called"); like($text, qr/TEST PLUGIN: claim_file .*TestPlugin\.pm$/m, "claim_file(TestPlugin.pm) was called"); like($text, qr/TEST PLUGIN: setup Test2::Harness::Settings/, "setup() was called with settings"); like($text, qr/TEST PLUGIN: teardown Test2::Harness::Settings/, "teardown() was called with settings"); like($text, qr/\(TESTPLUG\)\s+STDERR WRITE$/m, "Got the STDERR write from the shellcall"); like($text, qr/\(TESTPLUG\)\s+STDOUT WRITE$/m, "Got the STDOUT write from the shellcall"); like( $text, qr/TEST PLUGIN: finish asserts_seen => 10, final_data => HASH, pass => 1, settings => Test2::Harness::Settings, tests_seen => 5/, "finish() was called with necessary args" ); is(@{[$text =~ m/TEST PLUGIN: setup/g]}, 1, "Only ran setup once"); is(@{[$text =~ m/TEST PLUGIN: teardown/g]}, 1, "Only ran teardown once"); is(@{[$text =~ m/TEST PLUGIN: finish/g]}, 1, "Only ran finish once"); if (ok($text =~ m/^FIELDS:(.*)$/m, "Found fields")) { my $data = decode_json($1); is( $data, [{ name => 'test_plugin', details => 'foo', raw => 'bar', data => 'baz', }], "Injected the run data" ); } my %rank = ( test => 1, c => 2, b => 3, a => 4, d => 5, ); my %jobs = reverse($text =~ m{job\s+(\d+)\s+.*\W(\w+)\.tx}g); is(\%jobs, \%rank, "Ran jobs in specified order"); } yath( command => 'test', args => [$dir, '--ext=tx', '-A', '--durations-threshold' => 1, '--no-plugins', '-pTestPlugin', '--changes-plugin', 'TestPlugin'], exit => 0, test => \&verify, ); unless ($ENV{AUTOMATED_TESTING} || $ENV{AUTHOR_TESTING}) { subtest persist => sub { verify( yath(command => 'start', args => ['--no-plugins', '-pTestPlugin'], exit => 0), yath(command => 'run', args => ['--no-plugins', '-pTestPlugin', '--changes-plugin', 'TestPlugin', exit => 0, $dir, '--ext=tx', '-A']), yath(command => 'stop', args => ['--no-plugins', '-pTestPlugin'], exit => 0), ); }; } done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/failed.t�������������������������������������������������������0000644�0001750�0001750�00000002003�15012417054�020463� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', args => [$dir, '--ext=tx'], log => 1, exit => T(), test => sub { my $out = shift; my $logfile = $out->{log}->name; $out = yath( command => 'failed', args => [$logfile], env => {TABLE_TERM_SIZE => 1000, TS_TERM_SIZE => 1000}, exit => 0, test => sub { my $out = shift; ok(!$out->{exit}, "'failed' command exits true"); like($out->{output}, qr{fail\.tx}, "'fail.tx' was seen as a failure when reading the log"); unlike($out->{output}, qr{pass\.tx}, "'pass.tx' was not seen as a failure when reading the log"); }, ); }, ); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/times.t��������������������������������������������������������0000644�0001750�0001750�00000001553�15012417054�020371� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use Test2::Harness::Util::File::JSONL; use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my $out = yath( command => 'test', args => [$dir, '--ext=tx'], log => 1, exit => 0, ); my $log = $out->{log}->name; yath( command => 'times', args => [$log], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{Total .* Startup .* Events .* Cleanup .* File}m, "Got header"); like($out->{output}, qr{t/integration/times/pass\.tx}m, "Got pass line"); like($out->{output}, qr{t/integration/times/pass2\.tx}m, "Got pass2 line"); like($out->{output}, qr{TOTAL}m, "Got total line"); }, ); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/smoke.t��������������������������������������������������������0000644�0001750�0001750�00000003633�15012417054�020367� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', pre => ['-p+SmokePlugin'], args => [$dir, '--ext=tx'], log => 1, exit => 0, test => \&the_test, ); yath( command => 'test', pre => ['-p+SmokePlugin'], args => [$dir, '-j3', '--ext=tx'], log => 1, exit => 0, test => \&the_test, ); sub the_test { my $out = shift; my $log = $out->{log}; my @order; my @events = $log->poll(); while (@events) { if (my $event = shift @events) { my $f = $event->{facet_data}; if (my $l = $f->{harness_job_start}) { push @order => $l; } } # Check for additional events, probably should not have any, but we may hit # a buffering limit in the log reader and need additional polls. push @events => $log->poll; } # We care about the order in which events happened based on time stamp, not the # order in which they were collected, which may be different. Here we will sort # based on stamp. @order = sort { $a->{stamp} <=> $b->{stamp} } @order; is( [map { $_->{rel_file} } @order[0 .. 3]], bag { item match qr/a\.tx$/; item match qr/c\.tx$/; item match qr/e\.tx$/; item match qr/g\.tx$/; end; }, "The 4 smoke tests ran first" ); is( [map { $_->{rel_file} } @order[4 .. 7]], bag { item match qr/b\.tx$/; item match qr/d\.tx$/; item match qr/f\.tx$/; item match qr/h\.tx$/; end; }, "The 4 non-smoke tests ran later" ); } done_testing; �����������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/retry.t��������������������������������������������������������0000644�0001750�0001750�00000010314�15012417054�020410� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-DURATION-LONG use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; run_tests('test'); my $project = "asgadfgds"; unless ($ENV{AUTOMATED_TESTING}) { my $out = yath( command => 'start', pre => ['--project', $project], args => [], exit => 0, test => sub { run_tests('run'); yath(command => 'stop', args => [], exit => 0); } ); } sub run_tests { my ($cmd) = @_; yath( command => $cmd, pre => ['--project', $project], args => [$dir, '--ext=tx', '-r3'], log => 1, exit => 0, test => sub { my $out = shift; my $final = ($out->{log}->poll())[-2]; is($final->{facet_data}->{harness_final}->{pass}, T(), "Passed in log"); }, ); yath( command => $cmd, pre => ['--project', $project], args => [$dir, '--ext=tx', '-r3', '--env-var' => "FAIL_ONCE=1", '-v'], log => 1, exit => 0, debug => 0, test => sub { my $out = shift; my $final = ($out->{log}->poll())[-2]; my $retry_data = $final->{facet_data}->{harness_final}->{retried}->[0]; ok($retry_data, "got retry data") or return; my ($uuid, $tries, $file, $status) = @$retry_data; is($tries, 2, "Tried twice"); like($file, qr{retry\.tx}, "Retried the right file"); is($status, 'YES', "Eventually passed"); }, ); yath( command => $cmd, pre => ['--project', $project], args => [$dir, '--ext=tx', '-r3', '--env-var' => "FAIL_ALWAYS=1"], log => 1, exit => T(), test => sub { my $out = shift; my $final = ($out->{log}->poll())[-2]; my $retry_data = $final->{facet_data}->{harness_final}->{retried}->[0]; my ($uuid, $tries, $file, $status) = @$retry_data; is($tries, 4, "Tried 4 times: 1 run + 3 retries"); like($file, qr{retry\.tx}, "Retried the right file"); is($status, 'NO', "Never passed"); }, ); { note q[Retrying a symlink]; my $sdir = $dir . '-symlinks'; my $symlink = "$sdir/symlink.tl"; unlink $symlink if -e $symlink; if ( eval{ symlink('retry.tx', $symlink) } ) { yath( command => 'test', args => [$sdir, '--ext=tl', '--retry' => 1, '--env-var' => "FAIL_ONCE=1", '-v' ], log => 1, exit => 0, test => sub { my $out = shift; my $final = ($out->{log}->poll())[-2]; my $retry_data = $final->{facet_data}->{harness_final}->{retried}->[0]; my ($uuid, $tries, $file, $status) = @$retry_data; is $tries, 2, 'retried a broken symlink'; is $file, 't/integration/retry-symlinks/symlink.tl', "using symlink name"; is $status, 'YES', 'Succeeded Eventually: YES'; unlike($out->{output}, qr{FAILED}, q[no failures]); }, ); } } { note q[Retrying a test failing due to a timeout]; my $sdir = $dir . '-timeout'; yath( command => 'test', args => [$sdir, '--ext=tx', '--retry' => 1, '--env-var' => "FAIL_ONCE=1", '-v' ], log => 1, exit => 0, test => sub { my $out = shift; my $final = ($out->{log}->poll())[-2]; my $retry_data = $final->{facet_data}->{harness_final}->{retried}->[0]; my ($uuid, $tries, $file, $status) = @$retry_data; #note $out->{output}; is $tries, 2, 'retried a test when failing due to a timeout'; is $file, 't/integration/retry-timeout/retry.tx', "retry.txt test"; is $status, 'YES', 'Succeeded Eventually: YES'; unlike($out->{output}, qr{FAILED}, q[no failures]); }, ); } }; done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/test.t���������������������������������������������������������0000644�0001750�0001750�00000017076�15012417054�020236� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Config qw/%Config/; use File::Temp qw/tempfile/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util qw/clean_path/; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', args => [$dir, '--ext=tx', '--ext=txx'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the output"); like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); yath( command => 'test', args => [$dir, '--ext=tx'], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the output"); like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); yath( command => 'test', args => [$dir, '--ext=txx'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the output"); unlike($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); yath( command => 'test', args => [$dir, '-vvv'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr/No tests were seen!/, "Got error message"); }, ); note q[Checking --exclude-file option when a file is provided on the command line]; yath( command => 'test', args => [ "--exclude-file=$dir/fail.txx", "$dir/pass.tx", "$dir/fail.txx" ], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was excluded using '--exclude-file' option"); like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); note q[Checking --exclude-list option when a file is provided on the command line]; my ($fh, $list_name) = tempfile(UNLINK => 1); print $fh "# GENERATED YATH TEST EXCLUSION LIST\n#$dir/pass.tx\n$dir/fail.txx"; close($fh); yath( command => 'test', args => ["--exclude-list=$list_name", "$dir/pass.tx", "$dir/fail.txx"], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was excluded using '--exclude-list' option with a file"); like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); { note q[Testsuite using symlinks: check that $0 is preserved]; my $sdir = $dir . '-symlinks'; my $base = "$sdir/_base.xt"; my $symlink = "$sdir/symlink_to_base.xt"; unlink $symlink if -e $symlink; if ( eval{ symlink('_base.xt', $symlink) } ) { yath( command => 'test', args => [$sdir, '--ext=xt' ], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{SKIPPED.*\Q$base\E}, "'_base.xt' was skipped"); like($out->{output}, qr{PASSED.*\Q$symlink\E}, "'symlink_to_base.xt' passed [and is not skipped]"); }, ); yath( command => 'test', args => [ $base, $symlink ], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{SKIPPED.*\Q$base\E}, "'_base.xt' was skipped"); like($out->{output}, qr{PASSED.*\Q$symlink\E}, "'symlink_to_base.xt' passed [and is not skipped]"); }, ); } } { note q[Testsuite checking broken symlinks #103]; my $sdir = $dir . '-broken-symlinks'; my $symlink = "$sdir/broken-symlink.tx"; unlink $symlink if -e $symlink; if ( eval{ symlink('nothing-there', $symlink) } ) { yath( command => 'test', args => [$sdir, '--ext=tx' ], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr{FAILED}, q[no failures]); unlike($out->{output}, qr{\Qbroken-symlink.tx\E}, q[no mention of broken-symlink.tx] ); like($out->{output}, qr{PASSED.*\Qt/integration/test-broken-symlinks/pass.tx\E}, q[t/integration/test-broken-symlinks/pass.tx PASSED]); }, ); } } { note "Testing durations when provided using a json file"; my $sdir = $dir . '-durations'; # using a directory yath( command => 'test', args => [ '-v', '-j1', '--durations', "$sdir/../test-durations.json", '--ext=tx', $sdir, ], exit => 0, test => sub { my $out = shift; my @lines = sort { my ($aj) = ($a =~ m/job\s+(\d+)/) or return 0; my ($bj) = ($b =~ m/job\s+(\d+)/) or return 0; return $aj <=> $bj; } grep { m/\Q( PASSED )\E/ } split /\n/, $out->{output}; is \@lines, array { item match qr{\Qslow-01.tx\E}; item match qr{\Qslow-02.tx\E}; item match qr{\Qfast-01.tx\E}; item match qr{\Qfast-02.tx\E}; item match qr{\Qfast-03.tx\E}; item match qr{\Qfast-04.tx\E}; end; }, "tests are run in order from slow to fast - using a directory"; }, ); # using a list of files my @files = ( "$sdir/fast-01.tx", "$sdir/fast-02.tx", "$sdir/fast-03.tx", "$sdir/fast-04.tx", "$sdir/slow-01.tx", "$sdir/slow-02.tx" ); my %hfiles = map { $_ => 1 } @files; yath( command => 'test', args => [ '-v', '-j1', '--durations', "$sdir/../test-durations.json", '--ext=tx', keys %hfiles, # random order ], exit => 0, test => sub { my $out = shift; my @lines = sort { my ($aj) = ($a =~ m/job\s+(\d+)/) or return 0; my ($bj) = ($b =~ m/job\s+(\d+)/) or return 0; return $aj <=> $bj; } grep { m/\Q( PASSED )\E/ } split /\n/, $out->{output}; is \@lines, array { item match qr{\Qslow-01.tx\E}; item match qr{\Qslow-02.tx\E}; item match qr{\Qfast-01.tx\E}; item match qr{\Qfast-02.tx\E}; item match qr{\Qfast-03.tx\E}; item match qr{\Qfast-04.tx\E}; end; }, "tests are run in order from slow to fast - using a list of files"; }, ); } if ("$]" >= 5.026) { note q[Checking %INC and @INC setup]; local @INC = map { clean_path( $_ ) } grep { $_ ne '.' } @INC; local $ENV{PERL5LIB} = join $Config{path_sep}, map { clean_path( $_ ) } grep { $_ ne '.' } split( $Config{path_sep}, $ENV{PERL5LIB} ); local $ENV{PERL_USE_UNSAFE_INC}; delete $ENV{PERL_USE_UNSAFE_INC}; my $sdir = $dir . '-inc'; yath( command => 'test', args => ['--ext=tx', '--no-unsafe-inc', $sdir], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr{FAILED}, q[no failures]); }, ); } yath( command => 'test', args => [$dir, '--ext=txxx', '::', 'foobar', 'baz' ], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{PASSED}, 'Args after arisdottle are added to @ARGV'); }, ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/init.t���������������������������������������������������������0000644�0001750�0001750�00000001372�15012417054�020212� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use Cwd qw/cwd/; use App::Yath::Tester qw/yath/; use App::Yath::Util qw/find_yath/; find_yath(); # cache result before we chdir my $orig = cwd(); my $dir = tempdir(CLEANUP => 1); chdir($dir); yath( command => 'init', args => [], exit => 0, test => sub { like($_, qr/Writing test\.pl/, "Short message"); ok(-e 'test.pl', "Added test.pl"); open(my $fh, '<', 'test.pl') or die $!; my $found = 0; while (my $line = <$fh>) { next unless $line =~ m/THIS IS A GENERATED YATH RUNNER TEST/; $found++; last; } ok($found, "Found generated note"); }, ); chdir($orig); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/integration/help.t���������������������������������������������������������0000644�0001750�0001750�00000004562�15012417054�020203� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use App::Yath::Util qw/find_yath/; yath( command => 'help', args => [], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{^Usage: .*yath COMMAND \[options\]$}m, "Found usage statement"); like($out->{output}, qr{^Available Commands:$}m, "available commands"); # Sample some essential commands like($out->{output}, qr{^\s+help: Show the list of commands$}m, "'help' command is listed"); like($out->{output}, qr{^\s+test: Run tests$}m, "'test' command is listed"); like($out->{output}, qr{^\s+start: Start the persistent test runner$}m, "'start' command is listed"); }, ); yath( command => 'help', args => ['help'], exit => 0, test => sub { my $out = shift; my $script = find_yath(); is($out->{output}, <<" EOT", "Got output for the help command"); help - Show the list of commands This command provides a list of commands when called with no arguments. When given a command name as an argument it will print the help for that command. Usage: $script help EOT }, ); yath( command => 'help', args => ['test'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{^test - Run tests$}m, "Found summary"); like($out->{output}, qr{^\[YATH OPTIONS\]$}m, "Found yath options"); like($out->{output}, qr{^ Developer$}m, "Found Developer category"); like($out->{output}, qr{^ Help and Debugging$}m, "Found help category"); like($out->{output}, qr{^ Plugins$}m, "Found plugin category"); like($out->{output}, qr{^\[COMMAND OPTIONS\]$}m, "Found command options"); like($out->{output}, qr{^ Display Options$}m, "Found display category"); like($out->{output}, qr{^ Formatter Options$}m, "Found formatter category"); like($out->{output}, qr{^ Logging Options$}m, "Found logging category"); like($out->{output}, qr{^ Run Options$}m, "Found run category"); like($out->{output}, qr{^ Runner Options$}m, "Found runner category"); like($out->{output}, qr{^ Workspace Options$}m, "Found workspace category"); }, ); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/����������������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�015513� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/����������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�016514� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Tools/����������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�017614� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Tools/HarnessTester.t�������������������������������������������0000644�0001750�0001750�00000001522�15012417054�022573� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Tools::HarnessTester'; use Test2::Tools::HarnessTester qw/summarize_events/; imported_ok qw/summarize_events/; my $events = intercept { ok(1, "Pass") for 1 .. 4; ok(0, "Fail"); ok(1, "Pass"); done_testing; }; is( summarize_events($events), { assertions => 6, errors => 0, fail => 1, failures => 1, pass => 0, plan => {count => 6}, }, "Failure, assertion count, plan", ); $events = intercept { ok(1, "Pass") for 1 .. 4; done_testing; }; is( summarize_events($events), { assertions => 4, errors => 0, fail => 0, failures => 0, pass => 1, plan => {count => 4}, }, "pass, assertion count, plan", ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/��������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020117� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Runner/�������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021370� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Runner/Resource/����������������������������������������0000755�0001750�0001750�00000000000�15012417054�023157� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Runner/Resource/SharedJobSlots/�������������������������0000755�0001750�0001750�00000000000�15012417054�026045� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Runner/Resource/SharedJobSlots/.sharedjobslots.yml������0000644�0001750�0001750�00000001332�15012417054�031673� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������--- COMMON: state_file: /tmp/yath-state-config-test algorithm: fair max_slots: 4 max_slots_per_job: 2 max_slots_per_run: 4 default_slots_per_run: 2 default_slots_per_job: 2 DEFAULT: default_slots_per_run: 1 default_slots_per_job: 1 foo: max_slots: 13 max_slots_per_job: 5 max_slots_per_run: 13 default_slots_per_run: 3 default_slots_per_job: 2 bar: max_slots: 8 max_slots_per_job: 2 max_slots_per_run: 6 default_slots_per_run: 4 default_slots_per_job: 2 state_umask: 0077 baz: max_slots: 64 max_slots_per_job: 32 max_slots_per_run: 64 default_slots_per_run: 64 default_slots_per_job: 32 algorithm: first bat: ban: use_common: 0 baf: max_slots: 7 use_common: 0 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Runner/Resource/SharedJobSlots/Config.t�����������������0000644�0001750�0001750�00000010672�15012417054�027445� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Runner::Resource::SharedJobSlots::Config'; use Test2::Harness::Runner::Resource::SharedJobSlots::Config; my $dir = __FILE__; $dir =~ s{Config\.t$}{}g; chdir($dir) or die "Could not chdir ($dir): $!"; sub CONFIG { return { DEFAULT => { default_slots_per_run => 1, default_slots_per_job => 1, }, COMMON => { algorithm => 'fair', state_file => '/tmp/yath-state-config-test', max_slots => 4, max_slots_per_run => 4, max_slots_per_job => 2, default_slots_per_run => 2, default_slots_per_job => 2, }, foo => { max_slots => 13, max_slots_per_run => 13, max_slots_per_job => 5, default_slots_per_run => 3, default_slots_per_job => 2, }, bar => { max_slots => 8, max_slots_per_run => 6, max_slots_per_job => 2, default_slots_per_run => 4, default_slots_per_job => 2, state_umask => '0077', }, baz => { algorithm => 'first', max_slots => 64, max_slots_per_run => 64, max_slots_per_job => 32, default_slots_per_run => 64, default_slots_per_job => 32, }, bat => undef, ban => { use_common => '0', }, baf => { use_common => 0, max_slots => 7, }, }; } my $one = $CLASS->find(host => 'foo'); like( $one, hash { field host => 'foo'; field common_conf => CONFIG()->{COMMON}; field host_conf => CONFIG()->{foo}; field config_file => '.sharedjobslots.yml'; field config_raw => CONFIG(); etc; }, "Found the config file, loaded options" ); is($one->state_umask, 0007, "Got default umask"); is($one->state_file, '/tmp/yath-state-config-test', "Got state file from common"); is($one->algorithm, '_redistribute_fair', "got algorithm from common"); is($one->max_slots, 13, "got max slots from host"); is($one->min_slots_per_run, 0, "default min slots per run at 0"); is($one->max_slots_per_job, 5, "got max slots per job from host"); is($one->max_slots_per_run, 13, "got max slots per run from host"); is($one->default_slots_per_job, 2, "got default slots per job from host"); is($one->default_slots_per_run, 3, "got default slots per run from host"); $one = $CLASS->find(host => 'bar'); is($one->state_umask, '0077', "Got host umask"); $one = $CLASS->find(host => 'bat'); is($one->algorithm, '_redistribute_fair', "got algorithm from common"); is($one->max_slots, 4, "got max slots from common"); is($one->min_slots_per_run, 0, "default min slots per run at 0"); is($one->max_slots_per_job, 2, "got max slots per job from common"); is($one->max_slots_per_run, 4, "got max slots per run from common"); is($one->default_slots_per_job, 2, "got default slots per job from common"); is($one->default_slots_per_run, 2, "got default slots per run from common"); $one = $CLASS->find(host => 'baf'); is($one->algorithm, '_redistribute_fair', "got algorithm from default"); is($one->max_slots, 7, "got max slots from host"); is($one->min_slots_per_run, 0, "default min slots per run at 0"); is($one->max_slots_per_job, 7, "got max slots per job from default"); is($one->max_slots_per_run, 7, "got max slots per run from default"); is($one->default_slots_per_job, 7, "got default slots per job from default"); is($one->default_slots_per_run, 7, "got default slots per run from default"); is( dies { $one = $CLASS->find(host => 'ban') }, "'max_slots' not set in '\.sharedjobslots\.yml' for host 'ban' or under 'COMMON' config.\n", "Need a value for max slots" ); done_testing; ����������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Runner/Resource/SharedJobSlots/State.t������������������0000644�0001750�0001750�00000045414�15012417054�027322� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Runner::Resource::SharedJobSlots::State'; use File::Temp qw/tempfile/; use ok $CLASS; sub inst { my %params = @_; my $state_file = $params{state_file}; unless ($state_file) { my $fh; ($fh, $state_file) = tempfile(UNLINK => 1); close($fh); } return $CLASS->new( state_file => $state_file, max_slots => 10, max_slots_per_job => 3, max_slots_per_run => 9, runner_pid => $$, %params, ); } subtest init_checks => sub { for my $field (qw/state_file max_slots max_slots_per_job max_slots_per_run/) { my %proto = ( state_file => '/dev/null', max_slots => 100, max_slots_per_job => 5, max_slots_per_run => 50, ); # Remove the field we are testing for. delete $proto{$field}; like( dies { $CLASS->new(%proto) }, qr/'$field' is a required attribute/, "Require '$field' be provided" ); } my $one = inst(); isa_ok($one, [$CLASS], "Created an instance"); }; subtest init_state => sub { my $one = inst(runner_id => 'one'); my $state = $one->transaction('w'); like( $state, { runners => { one => {runner_id => 'one'}, # The runner added for our transacton }, }, "Got initial state" ); # Remove the local data (not stored) my $local = delete $state->{local}; like( $local, { lock => FDNE, # The lock should not be present anymore (it is weakened inside the transaction, gone after) write => T, # This was a write transaction }, "Local data is as expected", ); my $stored = Test2::Harness::Util::File::JSON->new(name => $one->state_file)->read; is($state, $stored, "state and stored match"); }; subtest transaction => sub { my $one = inst(runner_id => 'one'); my $end_state = $one->transaction( w => sub { my ($the_one, $state, @args) = @_; ref_is($the_one, $one, "Got the instance first"); ref_ok($state, 'HASH', "got a hash"); is(\@args, [qw/arg1 arg2/], "Got additional args"); my $local_check = { lock => T(), write => T(), mode => 'w', stack => [ {cb => T(), args => ['arg1', 'arg2']}, ] }; is($state->{local}, $local_check, "Got accurate state"); subtest nested_transaction => sub { $one->transaction( 'r' => sub { my ($also_the_one, $also_state) = @_; ref_is($also_the_one, $one, "got the same instance"); ref_is($also_state, $state, "Got the same state object"); is( $state->{local}, { lock => T(), write => F(), mode => 'r', stack => [ {cb => T(), args => ['arg1', 'arg2']}, {cb => T(), args => []}, ] }, "State temporarily modified" ); }, ); }; is($one->transaction(), $state, "transaction with no callback returns state"); is($state->{local}, $local_check, "State restored"); return $state; }, 'arg1', 'arg2' ); like( $end_state, { local => {lock => FDNE}, # Lock released runners => { one => { # Added runner user => $ENV{USER}, seen => T(), added => T(), runner_id => 'one', }, }, }, "Got correct end state" ); my $two = inst(runner_id => 'two', state_file => $one->{state_file}); my $state = $two->update_registration; ok($state->{runners}->{two}, "Got registration"); $two->transaction( rw => sub { my ($me, $state) = @_; $state->{runners}->{two}->{remove} = 1; } ); $state = $one->transaction( ro => sub { my ($me, $state) = @_; ok(!$state->{runners}->{two}, "Two is not registered anymore"); } ); like( dies { $two->transaction('rw') }, qr/Shared slot registration expired/, "Cannot proceed if our registration expired", ); my $three = inst(runner_id => 'three', state_file => $one->{state_file}); $state = $three->update_registration; ok($state->{runners}->{three}, "Got registration"); $one->transaction( rw => sub { my ($me, $state) = @_; $state->{runners}->{three}->{seen} = 1; # Very long time ago. } ); # Make sure RO mode is aware, even though it does not write the update $state = $one->transaction( ro => sub { my ($me, $state) = @_; ok(!$state->{runners}->{three}, "Three is not registered anymore (timed out)"); ok(!$state->{runners}->{two}, "Two is not registered anymore"); } ); $state = $one->transaction( rw => sub { my ($me, $state) = @_; ok(!$state->{runners}->{three}, "Three is not registered anymore (timed out)"); ok(!$state->{runners}->{two}, "Two is not registered anymore"); return $state; } ); delete $state->{local}; my $stored = Test2::Harness::Util::File::JSON->new(name => $one->state_file)->read; is($state, $stored, "state and stored match"); }; sub consistent_state { my ($insts, $state_check) = @_; my $ctx = context(); my $state; subtest "consistent state" => sub { my $base = $state = shift(@$insts); my $state = $base->state; my $idx = 1; while (my $i = shift @$insts) { my $st2 = $i->state; is($st2, $state, "state [" . $idx++ . "] matches state [0]"); } use Data::Dumper; is($state, $state_check, "State matches expectations", Dumper($state)) if $state_check; }; $ctx->release; return $state; } subtest registration => sub { my $one = inst(runner_id => 'one'); my $two = inst(runner_id => 'two', state_file => $one->{state_file}); my $three = inst(runner_id => 'three', state_file => $one->{state_file}); $one->update_registration; consistent_state( [$one, $two, $three], hash { field runners => { one => T(), }; etc; }, ); $two->update_registration; consistent_state( [$one, $two, $three], hash { field runners => { one => T(), two => T(), }; etc; }, ); $three->update_registration; consistent_state( [$one, $two, $three], hash { field runners => { one => T(), two => T(), three => T(), }; etc; }, ); $two->remove_registration; consistent_state( [$one, $two, $three], hash { field runners => { one => T(), two => DNE(), three => T(), }; etc; }, ); # Emulate 'three' timing out. my $file = Test2::Harness::Util::File::JSON->new(name => $one->{state_file}); my $data = $file->read; $data->{runners}->{three}->{seen} -= 100 + $one->TIMEOUT; $file->write($data); consistent_state( [$one, $two, $three], hash { field runners => { one => T(), two => DNE(), three => DNE(), }; etc; }, ); like( dies { $three->update_registration }, qr/Shared slot registration expired/, "Cannot write after timing out" ); }; subtest _entry_expired => sub { my $one = inst(runner_id => 'one'); ok($one->_entry_expired(undef), "Invalid entry is expired"); ok($one->_entry_expired({remove => 1}), "Entry to be removed is expired"); ok($one->_entry_expired({}), "no 'seen' field expired"); ok(!$one->_entry_expired({seen => time}), "Recently seen, not expired"); ok($one->_entry_expired({seen => (time - (10 + $one->TIMEOUT))}), "Old is expired"); }; subtest runner_todo => sub { my $one = inst(runner_id => 'one'); my $entry = {}; is($one->_runner_todo($entry), undef, "Nothing to do"); is($one->_runner_todo($entry, 'j1'), undef, "Nothing to do"); is($one->_runner_todo($entry, j1 => 2), 2, "Got job count"); is($entry->{todo}, 2, "todo is set"); is($one->_runner_todo($entry, j2 => 3), 3, "Got job count"); is($entry->{todo}, 5, "todo is set"); is($one->_runner_todo($entry, j3 => 1), 1, "Got job count"); is($entry->{todo}, 6, "todo is set"); is($one->_runner_todo($entry, 'j2'), 3, "Got job count"); is($entry->{todo}, 6, "todo is set"); is($one->_runner_todo($entry, j2 => -1), 3, "Got job count"); is($entry->{todo}, 3, "todo is set"); }; subtest _runner_calcs => sub { my $one = inst(runner_id => 'one'); my $r = { _calc_cache => "cache!", max_slots => 100, assigned => {1 => {count => 1}, 2 => {count => 2}}, allocated => 3, todo => 101, }; is($one->_runner_calcs($r), "cache!", "Get cache if it is present"); delete $r->{_calc_cache}; is( $one->_runner_calcs($r), { max => 9, # Use the global max as runner max is too high assigned => 3, active => 6, # Assigned + Allocated total => 107, # Active + TODO wants => 9, # We have more tests than slots, so we want the max }, "Calculated data", ); ok($r->{_calc_cache}, "Have a cache"); is($one->_runner_calcs($r), $r->{_calc_cache}, "Result matches cache"); $r->{_calc_cache}->{xxx} = 'added'; is($one->_runner_calcs($r), $r->{_calc_cache}, "Result matches cache"); is($one->_runner_calcs($r)->{xxx}, 'added', "Extra cache key found"); $r = { max_slots => 5, assigned => {1 => {count => 2}, 2 => {count => 2}}, allocated => 0, todo => 101, }; is( $one->_runner_calcs($r), { max => 5, # Use our max, less than the global assigned => 4, active => 4, # Assigned + Allocated total => 105, # Active + TODO wants => 5, # We want our max }, "Calculated data", ); $r = { assigned => {1 => {count => 5}, 2 => {count => 5}}, allocated => 2, todo => 101, }; is( $one->_runner_calcs($r), { max => 9, assigned => 10, active => 12, # Assigned + Allocated total => 113, # Active + TODO wants => 12, # We want what we are already using, even though it is higher than max. }, "Calculated data", ); }; subtest allocate_slots => sub { my $one = inst(runner_id => 'one'); like(dies { $one->allocate_slots(todo => 1) }, qr/'con' is required/, "con must be specified"); $one->{max_slots_per_job} = 10; $one->{my_max_slots_per_job} = 11; $one->{max_slots} = 11; like( dies { $one->allocate_slots(con => [11, 11], todo => 100) }, qr/Slot request exceeds max slots per job \(11 vs \(10 || 11 || 11\)\)/, "Cannot exceed slot limits A" ); $one->{max_slots_per_job} = 11; $one->{my_max_slots_per_job} = 10; $one->{max_slots} = 11; like( dies { $one->allocate_slots(con => [11, 11], todo => 100) }, qr/Slot request exceeds max slots per job \(11 vs \(11 || 10 || 11\)\)/, "Cannot exceed slot limits B" ); $one->{max_slots_per_job} = 11; $one->{my_max_slots_per_job} = 11; $one->{max_slots} = 10; like( dies { $one->allocate_slots(con => [11, 11], todo => 100) }, qr/Slot request exceeds max slots per job \(11 vs \(11 || 11 || 10\)\)/, "Cannot exceed slot limits C" ); $one->transaction(rw => sub { my ($self, $state) = @_; # Make sure we have an allocation so we do not trigger a redistribute. $state->{runners}->{one}->{allocated} = 5; $state->{runners}->{one}->{allotment} = 2; # Do calcs and cache them so we can verify they get cleared. my $calcs = $self->_runner_calcs($state->{runners}->{one}); $calcs->{CACHED} = 1; }); ok($one->state->{runners}->{one}->{_calc_cache}->{CACHED}, "runner calc cache is as expected", $one->state->{runners}->{one}->{_calc_cache}); is($one->state->{runners}->{one}->{allocated}, 5, "Allocation is 5"); is($one->allocate_slots(con => [4, 4], job_id => '123'), 4, "We got 4 slots!"); ok(!$one->state->{runners}->{one}->{_calc_cache}->{CACHED}, "Allocating slots reset runner calc cache", $one->state->{runners}->{one}->{_calc_cache}); is($one->state->{runners}->{one}->{allocated}, 4, "Allocation updated to 4"); }; done_testing; __END__ TODO do more testing on this sub _allocate_slots { my $self = shift; my ($state, %params) = @_; my $entry = $state->{runners}->{$self->{+RUNNER_ID}}; delete $entry->{_calc_cache}; my $count = $params{count}; my $job_id = $params{job_id}; $self->_runner_todo($entry, $job_id => $count); my $allocated = $entry->{allocated}; # We have what we need already allocated return $entry->{allocated} = $count if $count <= $allocated; # Our allocation, if any, is not big enough, free it so we do not have a # deadlock with all runner holding an insufficient allocation. $allocated = $entry->{allocated} = 0; my $calcs = $self->_runner_calcs($entry); for (0 .. 1) { $self->_redistribute($state) if $_; # Only run on second loop # Cannot do anything if we have no allotment or no available slots. # This will go to the next loop for a redistribution, or end the loop. my $allotment = $entry->{allotment} or next; my $available = $allotment - $calcs->{assigned} or next; # If our allotment is lower than the count we may end up never getting # enough, so we forcefully reduce the count. # We do this for busy systems where the pool is too small to meet the # request. But we do not reduce the count to the available level, # availability can change to match the allotment. my $c = min($allotment, $count); next unless $available >= $c; return $entry->{allocated} = $c; } return 0; } sub assign_slots { my $self = shift; my (%params) = @_; my $job = $params{job} or croak "'job' is required"; return $self->transaction(rw => '_assign_slots', job => $job); } sub _assign_slots { my $self = shift; my ($state, %params) = @_; my $entry = $state->{runners}->{$self->{+RUNNER_ID}}; delete $entry->{_calc_cache}; my $job = $params{job}; my $job_id = $job->{job_id}; my $allocated = $entry->{allocated}; my $count = $self->_runner_todo($entry, $job_id => -1); $job->{count} = $count; $job->{started} = time; $entry->{allocated} = 0; $entry->{assigned}->{$job->{job_id}} = $job; return $job; } sub release_slots { my $self = shift; my (%params) = @_; my $job_id = $params{job_id} or croak "'job_id' is required"; return $self->transaction(rw => '_release_slots', job_id => $job_id); } sub _release_slots { my $self = shift; my ($state, %params) = @_; my $entry = $state->{runners}->{$self->{+RUNNER_ID}}; my $job_id = $params{job_id}; delete $entry->{assigned}->{$job_id}; delete $entry->{_calc_cache}; $self->_runner_todo($entry, $job_id => -1); # Reduce our allotment if it makes sense to do so. my $calcs = $self->_runner_calcs($entry); $entry->{allotment} = $calcs->{total} if $entry->{allotment} > $calcs->{total}; } sub _redistribute { my $self = shift; my ($state) = @_; my $max_run = $self->{+MAX_SLOTS_PER_RUN}; my $wanted = 0; for my $runner (values %{$state->{+RUNNERS}}) { my $calcs = $self->_runner_calcs($runner); $runner->{allotment} = $calcs->{wants}; $wanted += $calcs->{wants}; } # Everyone gets what they want! my $max = $self->{+MAX_SLOTS}; return if $wanted <= $max; my $meth = $self->{+ALGORITHM}; return $self->$meth($state); } sub _redistribute_first { my $self = shift; my ($state) = @_; my $min = $self->{+MIN_SLOTS_PER_RUN}; my $max = $self->{+MAX_SLOTS}; my $c = 0; for my $runner (sort { $a->{added} <=> $b->{added} } values %{$state->{+RUNNERS}}) { my $calcs = $self->_runner_calcs($runner); my $wants = $calcs->{wants}; if ($max >= $wants) { $runner->{allotment} = $wants; } else { $runner->{allotment} = max($max, $min, 0); } $max -= $runner->{allotment}; $c++; } return; } sub _redistribute_fair { my $self = shift; my ($state) = @_; my $runs = scalar keys %{$state->{+RUNNERS}}; # Avoid a divide by 0 below. return unless $runs; my $total = $self->{+MAX_SLOTS}; my $min = $self->{+MIN_SLOTS_PER_RUN}; my $used = 0; for my $runner (values %{$state->{+RUNNERS}}) { my $calcs = $self->_runner_calcs($runner); # We never want less than the 'active' number my $set = $calcs->{active}; # If min is greater than the active number and there are todo tests, we # use the min instead. $set = $min if $set < $min && $runner->todo; $runner->{allotment} = $set; $used += $set; } my $free = $total - $used; return unless $free >= 1; # Is there a more efficient way to do this? Yikes! my @runners = values %{$state->{+RUNNERS}}; while ($free > 0) { @runners = sort { $a->{allotment} <=> $b->{allotment} || $a->{added} <=> $b->{added} } grep { my $c = $self->_runner_calcs($_); $c->{wants} > $_->{allotment} } @runners; $free--; $runners[0]->{allotment}++; } return; } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Runner/DepTracer.t��������������������������������������0000644�0001750�0001750�00000005306�15012417054�023432� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Runner::DepTracer'; # HARNESS-NO-PRELOAD BEGIN { skip_all 'TODO' } use ok $CLASS; unshift @INC => 't/lib'; subtest require_hook => sub { my $one = $CLASS->new; isa_ok($one, [$CLASS], "Made a new instance"); ok(!$one->real_require, "Did not find an existing require hook"); my $two = $CLASS->new; ref_is($one->my_require, $two->real_require, "Found the existing require hook"); require xxx; is($one->loaded, {}, "Nothing tracked yet"); $one->start; # use eval so we do not pre-bind the require eval qq(#line ${ \__LINE__ } "${ \__FILE__ }"\nrequire baz; 1) or die $@; is($one->loaded, {map { $_ => T } qw/baz.pm foo.pm bar.pm/}, "Loaded 3 modules"); is( $one->dep_map, { 'baz.pm' => [['main', 't/Test2/Harness/Runner/DepTracer.t']], 'foo.pm' => [['baz', 't/lib/baz.pm'], ['bar', 't/lib/bar.pm']], 'bar.pm' => [['baz', 't/lib/baz.pm']], }, "Built dep-map" ); $one->stop; eval "require Data::Dumper; 1" or die $@; is($one->loaded, {map { $_ => T } qw/baz.pm foo.pm bar.pm/}, "Did not track Data::Dumper"); $one->clear_loaded; $one->start; eval "use 5.8.9; 1" or die $@; is($one->loaded, {}, "Did not track from version import"); }; subtest inc_hook => sub { my $one = $CLASS->new; isa_ok($one, [$CLASS], "Made a new instance"); ok($one->real_require, "Did find an existing require hook"); my $two = $CLASS->new; ref_is($one->my_require, $two->real_require, "Found the existing require hook"); require xxx; is($one->loaded, {}, "Nothing tracked yet"); $one->start; # use eval so we do not pre-bind the require eval qq(#line ${ \__LINE__ } "${ \__FILE__ }"\nCORE::require('baz_core.pm'); 1) or die $@; is($one->loaded, {map { $_ => T } qw/baz_core.pm foo_core.pm bar_core.pm/}, "Loaded 3 modules"); is( $one->dep_map, { 'baz_core.pm' => [['main', 't/Test2/Harness/Runner/DepTracer.t']], # The @INC hook is limited, it can catch hidden loads for watching, # but it cannot trace deps when a thing is loaded more than once. 'foo_core.pm' => [['baz_core', 't/lib/baz_core.pm']], #, ['bar', 't/lib/bar_core.pm']], 'bar_core.pm' => [['baz_core', 't/lib/baz_core.pm']], }, "Built dep-map" ); $one->stop; eval "CORE::require('yyy.pm'); 1" or die $@; is($one->loaded, {map { $_ => T } qw/baz_core.pm foo_core.pm bar_core.pm/}, "Did not track yyy"); $one->clear_loaded; $one->start; eval "use 5.8.9; 1" or die $@; is($one->loaded, {}, "Did not track from version import"); }; done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Settings/�����������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021717� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Settings/Prefix.t���������������������������������������0000644�0001750�0001750�00000002540�15012417054�023342� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Settings::Prefix'; my $one = $CLASS->new(); isa_ok($one, [$CLASS], "Created an instance"); ref_ok($one, 'REF', "Hash is slightly obscured by an extra deref"); like( dies { $one->foo }, qr/The 'foo' field does not exist/, "Must use a valid field" ); ref_ok($one->vivify_field('foo'), 'SCALAR', "vivify returns a ref"); is($one->foo, undef, "Not set yet"); $one->foo('bar'); is($one->foo, 'bar', "Set value"); if ("$]" >= 5.016) { $one->foo = 'baz'; is($one->foo, 'baz', "Set via lvalue"); } else { $one->field(foo => 'baz'); } is($one->field('foo'), 'baz', "Got via field"); $one->field('foo', 'xxx'); is($one->field('foo'), 'xxx', "Set via field"); like( dies { $one->field('foo', 'bar', 'baz') }, qr/Too many arguments for field\(\)/, "Field only takes 2 args" ); like( dies { $CLASS->foo }, qr/Method foo\(\) must be called on a blessed instance/, "Autload does not work on class" ); is( $one->TO_JSON, { foo => 'xxx' }, "JSON structure" ); { $INC{'TheThing.pm'} = 1; package TheThing; use Test2::Harness::Util::HashBase qw/foo bar/; } my $res = $one->build('TheThing', bar => 'yyy'); isa_ok($res, ['TheThing'], "Created an instance"); is( $res, { foo => 'xxx', bar => 'yyy', }, "Created with args" ); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Util/���������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021034� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Util/File/����������������������������������������������0000755�0001750�0001750�00000000000�15012417054�021713� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Util/File/Stream.t��������������������������������������0000644�0001750�0001750�00000004174�15012417054�023341� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File::Stream'; use File::Temp qw/tempfile/; # HARNESS-DURATION-SHORT use ok $CLASS; my ($wh, $filename) = tempfile("test-$$-XXXXXXXX", TMPDIR => 1); print $wh ""; close($wh); ok(my $one = $CLASS->new(name => $filename), "New instance"); $one->write("line1\n"); $one->write("line2\n"); $one->write("line3\n"); $one->write("line"); my $fh = $one->open_file('<'); is( [<$fh>], ["line1\n", "line2\n", "line3\n", "line"], "file written as expected" ); is($one->read_line, "line1\n", "got first line"); is( [$one->poll], [ "line2\n", "line3\n", ], "Got unseen completed lines, but not incomplete line" ); is($one->read_line, undef, "no new lines are ready"); is( [$one->read], [ "line1\n", "line2\n", "line3\n", ], "Read gets lines" ); $one->write("4\n"); $one->write("line5"); is( [$one->read], [ "line1\n", "line2\n", "line3\n", "line4\n", ], "Read sees the new lines" ); is([$one->poll], ["line4\n"], "Poll sees new line after a read"); $one->write("\nline6"); is($one->read_line, "line5\n", "read_line moves to the next line"); is($one->read_line, undef, "no new lines are ready"); is([$one->poll], [], "no new lines are ready"); $one->set_done(1); is([$one->poll], ["line6"], "got unterminated line after 'done' was set"); $one->reset; is( [$one->read], [ "line1\n", "line2\n", "line3\n", "line4\n", "line5\n", ], "read all lines but the last unterminated one" ); is( [$one->poll], [ "line1\n", "line2\n", "line3\n", "line4\n", "line5\n", ], "poll all lines but the last unterminated one" ); $one->set_done(1); is([$one->poll], ["line6"], "got unterminated line after 'done' was set"); $one = undef; $one = $CLASS->new(name => $filename); $one->seek(6); is( [$one->poll], [ "line2\n", "line3\n", "line4\n", "line5\n", ], "Was able to seek past the first item", ); unlink($filename); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Util/File/Value.t���������������������������������������0000644�0001750�0001750�00000000752�15012417054�023160� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File::Value'; # HARNESS-DURATION-SHORT use ok $CLASS; isa_ok($CLASS, 'Test2::Harness::Util::File'); my $one = $CLASS->new(name => __FILE__); my $val = $one->read; chomp(my $no_tail = $val); is($val, $no_tail, "trailing newline was removed from the value"); $val = $one->read_line; is( $val, "use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File::Value';", "got line, no newline" ); done_testing; ����������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Util/File/JSONL.t���������������������������������������0000644�0001750�0001750�00000000576�15012417054�022775� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File::JSONL'; # HARNESS-DURATION-SHORT use ok $CLASS; isa_ok($CLASS, 'Test2::Harness::Util::File'); isa_ok($CLASS, 'Test2::Harness::Util::File::Stream'); is($CLASS->decode('{"a":1}'), {a => 1}, "decode will decode json"); is($CLASS->encode({}), "{}\n", "encode will encode json and append a newline"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Util/File/JSON.t����������������������������������������0000644�0001750�0001750�00000001130�15012417054�022644� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File::JSON'; # HARNESS-DURATION-SHORT use ok $CLASS; isa_ok($CLASS, 'Test2::Harness::Util::File'); my $one = $CLASS->new(name => 'fake'); is($one->decode('{"a":1}'), {a => 1}, "decode will decode json"); is($one->encode({}), "{}", "encode will encode json"); like( dies { $one->reset }, qr/line reading is disabled for json files/, "Got expected exception for reset()" ); like( dies { $one->read_line }, qr/line reading is disabled for json files/, "Got expected exception for read_line()" ); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Util/Term.t���������������������������������������������0000644�0001750�0001750�00000000364�15012417054�022133� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Util::Term'; # HARNESS-DURATION-SHORT use ok $CLASS => qw/USE_ANSI_COLOR/; imported_ok(qw/USE_ANSI_COLOR/); is(USE_ANSI_COLOR(), in_set(0, 1), "USE_ANSI_COLOR returns true or false"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Util/JSON.t���������������������������������������������0000644�0001750�0001750�00000001321�15012417054�021767� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util::JSON'; # HARNESS-DURATION-SHORT use ok $CLASS; imported_ok(qw{ JSON encode_json decode_json encode_pretty_json encode_canon_json }); ok(JSON(), "Have JSON constant"); can_ok(JSON(), ['new'], "JSON returns a class (" . JSON() . ")"); my $struct = { a => 1, b => 2 }; for my $encode_name (qw/encode_json encode_pretty_json encode_canon_json/) { is( decode_json(__PACKAGE__->can($encode_name)->($struct)), $struct, "Round Trip $encode_name+decode" ); is( decode_json(__PACKAGE__->can($encode_name)->(undef)), undef, "undef/null round-trip $encode_name+decode" ); } done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Util/File.t���������������������������������������������0000644�0001750�0001750�00000004720�15012417054�022103� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File'; # HARNESS-DURATION-SHORT use ok $CLASS; can_ok($CLASS, qw/name done set_done/); like( dies { $CLASS->new }, qr/'name' is a required attribute/, "Must provide the 'name' attribute" ); open(my $tmpfh, '<', __FILE__) or die "Could not open file: $!"; my $zed = $CLASS->new(name => __FILE__, fh => $tmpfh); is($zed->_init_fh, $tmpfh, "saved fh"); is($zed->fh->blocking, 0, "fh was set to non-blocking"); $zed = undef; my $one = $CLASS->new(name => __FILE__); my $two = $CLASS->new(name => '/some/super/fake/file/that must not exist'); ok($one->exists, "This file exists"); ok(!$two->exists, "The file does not exist"); is($one->decode('xxx'), 'xxx', "base class decode does nothing"); is($one->encode('xxx'), 'xxx', "base class encode does nothing"); ok(my $fh = $one->open_file, "opened file (for reading)"); ok(dies { $two->open_file }, "Cannot open file (for reading)"); my ($line) = split /\n/, $one->maybe_read, 2; like( $line, q{use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File';}, "Can read file (using maybe_read)" ); is( $two->maybe_read, undef, "maybe_read returns undef for non-existant file" ); ($line) = split /\n/, $one->read, 2; like( $line, q{use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File';}, "Can read file" ); ok(dies { $two->read }, "read() dies on missing file"); close($fh); ok($fh = $one->fh, "Can generate an FH"); is($one->fh, $fh, "FH is remembered"); is($fh->blocking, 0, "FH is non-blocking"); close($fh); is($two->fh, undef, "return undef for missing file"); $one->set_done(1); is($one->done, 1, "can set done"); $one->reset; ok(!$one->{_fh}, "removed fh"); ok(!$one->done, "cleared done flag"); $two->reset; is($two->read_line, undef, "cannot read lines from missing file"); is( $one->read_line, "use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File';\n", "Got first line" ); while(my $l = $one->read_line) { 1 } is($one->read_line, undef, "no line to read yet"); $one->set_done(1); is( $one->read_line, "This line MUST be here, and MUST not end with a newline.", "Got final line with no terminator" ); $one->reset; is( $one->read_line, "use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File';\n", "Got first line again after reset" ); #TODO: write (it is atomic) done_testing; __END__ This line MUST be here, and MUST not end with a newline.������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/TestFile.t����������������������������������������������0000644�0001750�0001750�00000055723�15012417054�022037� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::TestFile'; # HARNESS-DURATION-SHORT use ok $CLASS; use Test2::Tools::GenTemp qw/gen_temp/; my $tmp = gen_temp( long => "#!/usr/bin/perl\n\nuse strict;\n use warnings\n\n# HARNESS-CAT-LONG\n# HARNESS-NO-TIMEOUT\n# HARNESS-USE-ISOLATION\nfoo\n# HARNESS-NO-SEE\n", med1 => "# HARNESS-NO-PRELOAD\n", med2 => "#HARNESS-NO-FORK\n", all => "#HARNESS-NO-TIMEOUT\n# HARNESS-NO-STREAM\n# HARNESS-NO-FORK\n# HARNESS-NO-PRELOAD\n# HARNESS-USE-ISOLATION\n", notime => "#HARNESS-NO-TIMEOUT\n", warn => "#!/usr/bin/perl -w\n", taint => "#!/usr/bin/env perl -t -w\n", foo => "#HARNESS-CATEGORY-FOO\n#HARNESS-STAGE-FoO", meta => "#HARNESS-META-mykey-myval\n# HARNESS-META-otherkey-otherval\n# HARNESS-META mykey my-val2\n# HARNESS-META slack #my-val # comment after harness statement\n", package => "package Foo::Bar::Baz;\n# HARNESS-NO-PRELOAD\n", timeout => "# HARNESS-TIMEOUT-EVENT 90\n# HARNESS-TIMEOUT-POSTEXIT 85\n", timeout2 => "# HARNESS-TIMEOUT-EVENT-90\n# HARNESS-TIMEOUT-POST-EXIT 85\n", badtimeout => "# HARNESS-TIMEOUT-EVENTX 90\n# HARNESS-TIMEOUT-POSTEXITX 85\n", conflicts1 => "# HARNESS-CONFLICTS PASSWD\n", conflicts2 => "# HARNESS-CONFLICTS PASSWD DAEMON\n", conflicts3 => "# HARNESS-CONFLICTS PASSWD\n# HARNESS-CONFLICTS DAEMON # Nothing to see here\n", conflicts4 => "# HARNESS-CONFLICTS PASSWD DAEMON\n# HARNESS-CONFLICTS PASSWD\n# HARNESS-CONFLICTS PASSWD\n# HARNESS-CONFLICTS PASSWD DAEMON\n", extra_comments => "#!/usr/bin/perl\n\nuse strict;\n# comment here\n use warnings\n\n# copyright Dewey Cheatem and Howe\n# HARNESS-CAT-LONG\n# HARNESS-NO-TIMEOUT\n# HARNESS-USE-ISOLATION\n", smoke1 => "#HARNESS-SMOKE\n", smoke2 => "#HARNESS-YES-SMOKE\n", retry => "#HARNESS-RETRY\n", # mean retry once => --retry similar to --retry=1 retry5 => "#HARNESS-RETRY 5\n", retry_iso => "#HARNESS-RETRY-ISO\n", retry_iso3 => "#HARNESS-RETRY-ISO 3\n", no_retry => "#HARNESS-NO-RETRY\n", not_perl => "#!/usr/bin/bash\n", not_env_perl => "#!/usr/bin/env bash\n", binary => "\0\a\cX\e\n\cR", ); subtest timeouts => sub { my $one = $CLASS->new(file => File::Spec->catfile($tmp, 'timeout')); is($one->event_timeout, 90, "set event timeout"); is($one->post_exit_timeout, 85, "set event timeout"); my $task = $one->queue_item(42); is($task->{event_timeout}, 90, "event timeout made it to task"); is($task->{post_exit_timeout}, 85, "post-exit timeout made it to task"); my $two = $CLASS->new(file => File::Spec->catfile($tmp, 'timeout2')); is($two->event_timeout, 90, "set event timeout"); is($two->post_exit_timeout, 85, "set event timeout"); my $bad = $CLASS->new(file => File::Spec->catfile($tmp, 'badtimeout')); is( warnings { $bad->headers }, [ "'EVENTX' is not a valid timeout type, use 'EVENT' or 'POSTEXIT' at " . $bad->file . " line 1.\n", "'POSTEXITX' is not a valid timeout type, use 'EVENT' or 'POSTEXIT' at " . $bad->file . " line 2.\n", ], "Got warnings" ); }; subtest invalid => sub { like( dies { $CLASS->new(file => File::Spec->catfile($tmp, 'invalid')) }, qr/^Invalid test file/, "Need a valid test file" ); }; subtest meta => sub { my $foo = $CLASS->new(file => File::Spec->catfile($tmp, 'meta')); is([$foo->meta], [], "No key returns empty list"); is([$foo->meta('foo')], [], "Empty key returns empty list"); is([$foo->meta('mykey')], [qw/myval my-val2/], "Got both values for the 'mykey' key"); is([$foo->meta('otherkey')], ['otherval'], "Got other key"); is([$foo->meta('slack')], ['#my-val'], "Got hyphenated key"); }; subtest foo => sub { my $foo = $CLASS->new(file => File::Spec->catfile($tmp, 'foo')); is($foo->check_category, 'foo', "Category is foo"); is($foo->check_stage, 'FoO', "Stage is FoO, case-sensitive"); }; subtest package => sub { my $one = $CLASS->new(file => File::Spec->catfile($tmp, 'package')); is($one->queue_item(42)->{use_preload}, 0, "No preload"); }; subtest taint => sub { my $taint = $CLASS->new(file => File::Spec->catfile($tmp, 'taint'), queue_args => [via => ['xxx']]); is($taint->switches, ['-t', '-w'], "No SHBANG switches"); is($taint->shbang, {switches => ['-t', '-w'], line => "#!/usr/bin/env perl -t -w"}, "Parsed shbang"); is( $taint->queue_item(42), { category => 'general', duration => 'medium', stage => undef, file => $taint->file, rel_file => $taint->relative, job_name => 42, job_id => T(), stamp => T(), switches => ['-t', '-w'], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, binary => 0, non_perl => 0, smoke => 0, conflicts => [], via => ['xxx'], rank => T(), run_id => FDNE(), }, "Got queue item data", ); }; subtest warn => sub { my $warn = $CLASS->new(file => File::Spec->catfile($tmp, 'warn')); is($warn->switches, ['-w'], "got SHBANG switches"); is($warn->shbang, {switches => ['-w'], line => "#!/usr/bin/perl -w"}, "Parsed shbang"); is( $warn->queue_item(42), { category => 'general', duration => 'medium', stage => undef, file => $warn->file, rel_file => $warn->relative, job_name => 42, job_id => T(), stamp => T(), rank => T(), switches => ['-w'], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, binary => 0, non_perl => 0, smoke => 0, conflicts => [], run_id => FDNE(), }, "Got queue item data", ); }; subtest notime => sub { my $notime = $CLASS->new(file => File::Spec->catfile($tmp, 'notime')); is($notime->check_feature('timeout'), 0, "Timeouts turned off"); is($notime->check_feature('timeout', 1), 0, "Timeouts turned off with default 1"); is($notime->check_category, 'general', "Category is general"); is($notime->check_duration, 'long', "Duration is long"); is($notime->switches, [], "No SHBANG switches"); is($notime->shbang, {}, "No shbang"); is( $notime->queue_item(42), { category => 'general', duration => 'long', stage => undef, file => $notime->file, rel_file => $notime->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 0, binary => 0, non_perl => 0, smoke => 0, conflicts => [], run_id => FDNE(), }, "Got queue item data", ); }; subtest all => sub { my $all = $CLASS->new(file => File::Spec->catfile($tmp, 'all')); is($all->check_feature('timeout'), 0, "Timeouts turned off"); is($all->check_feature('timeout', 1), 0, "Timeouts turned off with default 1"); is($all->check_feature('fork'), 0, "Forking is off"); is($all->check_feature('fork', 1), 0, "Checking fork with different default"); is($all->check_feature('preload'), 0, "Preload is off"); is($all->check_feature('preload', 1), 0, "Checking preload with different default"); is($all->check_feature('isolation'), 1, "No isolation"); is($all->check_feature('isolation', 0), 1, "Use isolation with a default of false"); is($all->check_feature('stream'), 0, "Use stream"); is($all->check_feature('stream', 1), 0, "no stream with a default of true"); is($all->check_category, 'isolation', "Category is isolation"); is($all->switches, [], "No SHBANG switches"); is($all->shbang, {}, "No shbang"); is( $all->queue_item(42), { category => 'isolation', duration => 'long', stage => undef, file => $all->file, rel_file => $all->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 0, use_preload => 0, use_stream => 0, io_events => 1, use_timeout => 0, smoke => 0, conflicts => [], binary => 0, non_perl => 0, run_id => FDNE(), }, "Got queue item data", ); }; subtest med2 => sub { my $med2 = $CLASS->new(file => File::Spec->catfile($tmp, 'med2')); is($med2->check_feature('timeout'), 1, "Timeouts turned on"); is($med2->check_feature('timeout', 0), 0, "Timeouts turned off with default 0"); is($med2->check_feature('fork'), 0, "Forking is off"); is($med2->check_feature('fork', 1), 0, "Checking fork with different default"); is($med2->check_feature('preload'), 1, "Preload is on"); is($med2->check_feature('preload', 0), 0, "Checking preload with different default"); is($med2->check_feature('isolation'), 0, "No isolation"); is($med2->check_feature('isolation', 1), 1, "Use isolation with a default of true"); is($med2->check_feature('stream'), 1, "Use stream"); is($med2->check_feature('stream', 0), 0, "no stream with a default of false"); is($med2->check_category, 'general', "Category is general"); is($med2->check_duration, 'medium', "duration is medium"); is($med2->switches, [], "No SHBANG switches"); is($med2->shbang, {}, "No shbang"); is( $med2->queue_item(42), { run_id => FDNE(), category => 'general', duration => 'medium', stage => undef, file => $med2->file, rel_file => $med2->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 0, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, binary => 0, non_perl => 0, smoke => 0, conflicts => [], }, "Got queue item data", ); }; subtest med1 => sub { my $med1 = $CLASS->new(file => File::Spec->catfile($tmp, 'med1')); is($med1->check_feature('timeout'), 1, "Timeouts turned on"); is($med1->check_feature('timeout', 0), 0, "Timeouts turned off with default 0"); is($med1->check_feature('fork'), 1, "Forking is ok"); is($med1->check_feature('fork', 0), 0, "Checking fork with different default"); is($med1->check_feature('preload'), 0, "Preload is off"); is($med1->check_feature('preload', 1), 0, "Checking preload with different default"); is($med1->check_feature('isolation'), 0, "No isolation"); is($med1->check_feature('isolation', 1), 1, "Use isolation with a default of true"); is($med1->check_feature('stream'), 1, "Use stream"); is($med1->check_feature('stream', 0), 0, "no stream with a default of false"); is($med1->check_category, 'general', "Category is general"); is($med1->check_duration, 'medium', "duration is medium"); is($med1->switches, [], "No SHBANG switches"); is($med1->shbang, {}, "No shbang"); is( $med1->queue_item(42), { run_id => FDNE(), category => 'general', duration => 'medium', stage => undef, file => $med1->file, rel_file => $med1->relative, job_name => 42, stamp => T(), rank => T(), job_id => T(), switches => [], use_fork => 1, use_preload => 0, use_stream => 1, io_events => 1, use_timeout => 1, binary => 0, non_perl => 0, smoke => 0, conflicts => [], }, "Got queue item data", ); }; subtest long => sub { my $long = $CLASS->new(file => File::Spec->catfile($tmp, 'long')); is($long->check_feature('timeout'), 0, "Timeouts turned off"); is($long->check_feature('timeout', 1), 0, "Timeouts turned off even with default 1"); is($long->check_feature('fork'), 1, "Forking is ok"); is($long->check_feature('fork', 0), 0, "Checking fork with different default"); is($long->check_feature('preload'), 1, "Preload is ok"); is($long->check_feature('preload', 0), 0, "Checking preload with different default"); is($long->check_feature('isolation'), 1, "Use isolation"); is($long->check_feature('isolation', 0), 1, "Use isolation even with a default of false"); is($long->check_feature('stream'), 1, "Use stream"); is($long->check_feature('stream', 0), 0, "no stream with a default of false"); is($long->check_category, 'isolation', "Category is isolation"); is($long->check_duration, 'long', "duration is long"); ok(!exists $long->headers->{SEE}, "Did not see directive after code line"); is($long->switches, [], "No SHBANG switches"); is($long->shbang, {switches => [], line => "#!/usr/bin/perl"}, "got shbang"); is( $long->queue_item(42), { run_id => FDNE(), category => 'isolation', duration => 'long', stage => undef, file => $long->file, rel_file => $long->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 0, binary => 0, non_perl => 0, smoke => 0, conflicts => [], }, "Got queue item data", ); }; subtest extra_comments => sub { my $long = $CLASS->new(file => File::Spec->catfile($tmp, 'extra_comments')); is($long->check_feature('timeout'), 0, "Timeouts turned off"); is($long->check_feature('timeout', 1), 0, "Timeouts turned off even with default 1"); is($long->check_feature('fork'), 1, "Forking is ok"); is($long->check_feature('fork', 0), 0, "Checking fork with different default"); is($long->check_feature('preload'), 1, "Preload is ok"); is($long->check_feature('preload', 0), 0, "Checking preload with different default"); is($long->check_feature('isolation'), 1, "Use isolation"); is($long->check_feature('isolation', 0), 1, "Use isolation even with a default of false"); is($long->check_feature('stream'), 1, "Use stream"); is($long->check_feature('stream', 0), 0, "no stream with a default of false"); is($long->check_category, 'isolation', "Category is isolation"); is($long->check_duration, 'long', "Duration is long"); is($long->switches, [], "No SHBANG switches"); is($long->shbang, {switches => [], line => "#!/usr/bin/perl"}, "got shbang"); is( $long->queue_item(42), { run_id => FDNE(), category => 'isolation', duration => 'long', stage => undef, file => $long->file, rel_file => $long->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 0, binary => 0, non_perl => 0, smoke => 0, conflicts => [], }, "Got queue item data", ); }; subtest conflicts => sub { my $parsed_file = $CLASS->new(file => File::Spec->catfile($tmp, 'conflicts1')); is($parsed_file->conflicts_list, ['passwd'], "1 conflict line is reflected as an array"); $parsed_file = $CLASS->new(file => File::Spec->catfile($tmp, 'conflicts2')); is([sort @{$parsed_file->conflicts_list}], ['daemon', 'passwd'], "1 conflict line with 2 conflict categories"); $parsed_file = $CLASS->new(file => File::Spec->catfile($tmp, 'conflicts3')); is([sort @{$parsed_file->conflicts_list}], ['daemon', 'passwd'], "2 conflict lines with some comments on one of them"); $parsed_file = $CLASS->new(file => File::Spec->catfile($tmp, 'conflicts4')); is([sort @{$parsed_file->conflicts_list}], ['daemon', 'passwd'], "Duplicate conflict lines only lead to 2 conflict items."); }; subtest binary => sub { my $path = File::Spec->catfile($tmp, 'binary'); ok(-B $path, "File is binary"); like( dies { my $binary = $CLASS->new(file => $path); $binary->shbang }, qr{Cannot run binary test file '[^']*\Q$path\E': file is not executable\.}, "File must be executable", ); my $control = mock $CLASS => ( override => [ is_executable => sub { 1 }, ], ); my $binary = $CLASS->new(file => $path); is($binary->switches, [], "No SHBANG switches"); is($binary->shbang, {}, "No shbang"); is( $binary->queue_item(42), { run_id => FDNE(), category => 'general', duration => 'medium', stage => undef, file => match qr{\Q$path\E$}, rel_file => $binary->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, conflicts => [], binary => 1, non_perl => 1, smoke => 0, }, "Got queue item data", ); }; subtest not_perl => sub { my $path = File::Spec->catfile($tmp, 'not_perl'); my $not_perl = $CLASS->new(file => File::Spec->catfile($tmp, 'not_perl')); is($not_perl->switches, [], "No SHBANG switches"); is($not_perl->shbang, {line => "#!/usr/bin/bash", non_perl => 1}, "Non-perl shbang"); is( $not_perl->queue_item(42), { run_id => FDNE(), category => 'general', duration => 'medium', stage => undef, file => match qr{\Q$path\E$}, rel_file => $not_perl->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, conflicts => [], binary => 0, non_perl => 1, smoke => 0, }, "Got queue item data", ); }; subtest not_env_perl => sub { my $path = File::Spec->catfile($tmp, 'not_env_perl'); my $not_env_perl = $CLASS->new(file => File::Spec->catfile($tmp, 'not_env_perl')); is($not_env_perl->switches, [], "No SHBANG switches"); is($not_env_perl->shbang, {line => "#!/usr/bin/env bash", non_perl => 1}, "Non-perl shbang"); is( $not_env_perl->queue_item(42), { run_id => FDNE(), category => 'general', duration => 'medium', stage => undef, file => match qr{\Q$path\E$}, rel_file => $not_env_perl->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, conflicts => [], smoke => 0, binary => 0, non_perl => 1, }, "Got queue item data", ); }; subtest smoke => sub { my $path = File::Spec->catfile($tmp, 'smoke1'); my $smoke1 = $CLASS->new(file => $path); is($smoke1->check_feature(smoke => 0), 1, "Turned smoke on"); is( $smoke1->queue_item(42), { run_id => FDNE(), category => 'general', duration => 'medium', stage => undef, file => match qr{\Q$path\E$}, rel_file => $smoke1->relative, job_name => 42, rank => T(), job_id => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, binary => 0, non_perl => 0, smoke => 1, conflicts => [], }, "Got queue item data", ); my $smoke2 = $CLASS->new(file => File::Spec->catfile($tmp, 'smoke2')); is($smoke2->check_feature(smoke => 0), 1, "Turned smoke on"); }; subtest smoke => sub { my $retry = $CLASS->new(file => File::Spec->catfile($tmp, 'retry')); my $task = $retry->queue_item(42); is($task->{retry}, 1, "Enabled retry"); ok(!exists($task->{retry_isolated}), "not isolated"); $retry = $CLASS->new(file => File::Spec->catfile($tmp, 'retry5')); $task = $retry->queue_item(42); is($task->{retry}, 5, "Enabled retry, value of 5 results in '6' because of initial try"); ok(!exists($task->{retry_isolated}), "not isolated"); $retry = $CLASS->new(file => File::Spec->catfile($tmp, 'retry_iso')); $task = $retry->queue_item(42); is($task->{retry}, 1, "Enabled retry"); is($task->{retry_isolated}, T(), "isolated retry"); $retry = $CLASS->new(file => File::Spec->catfile($tmp, 'retry_iso3')); $task = $retry->queue_item(42); is($task->{retry}, 3, "Enabled retry, 1 initital + 3 retries"); is($task->{retry_isolated}, T(), "isolated retry"); $retry = $CLASS->new(file => File::Spec->catfile($tmp, 'no_retry')); $task = $retry->queue_item(42); is($task->{retry}, 0, "Retry set to 0"); ok(!exists($task->{retry_isolated}), "not isolated"); }; done_testing; ���������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Settings.t����������������������������������������������0000644�0001750�0001750�00000003660�15012417054�022111� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Settings'; use File::Temp qw/tempfile/; use Test2::Harness::Util::JSON qw/encode_json/; my $one = $CLASS->new(); isa_ok($one, [$CLASS], "Created an instance"); ok(!$one->check_prefix('foo'), "foo is not defined"); like(dies { $one->foo }, qr/The 'foo' prefix is not defined/, "Cannot call foo if it is not defined"); like(dies { $one->prefix('foo') }, qr/The 'foo' prefix is not defined/, "Cannot call prefix(foo) if it is not defined"); $one->define_prefix('foo'); isa_ok($one->foo, ['Test2::Harness::Settings::Prefix'], "Defined the prefix"); ok($one->check_prefix('foo'), "foo is now defined"); ok($one->foo, "Can call foo if it is defined"); ok($one->prefix('foo'), "Can call prefix(foo) if it is defined"); is($one->TO_JSON, {foo => exact_ref($one->foo)}, "TO_JSON"); like(dies { $CLASS->foo }, qr/Method foo\(\) must be called on a blessed instance/, "Need a blessed instance"); like(dies { $one->foo(1) }, qr/Too many arguments for foo\(\)/, "No args"); { $INC{'XXX.pm'} = __FILE__; package XXX; sub new { shift; bless {@_}, 'XXX' }; } $one->foo->vivify_field('xxx'); $one->foo->field(xxx => 'yyy'); my $thing = $one->build('foo', 'XXX', a => 'b'); isa_ok($thing, ['XXX'], "Got a blessed instance of XXX"); is( $thing, { a => 'b', xxx => 'yyy', }, "Instance is composed as expected" ); my ($fh, $name) = tempfile(UNLINK => 1); print $fh encode_json($one); close($fh); my $two = $CLASS->new($name); isa_ok($two, [$CLASS], "Correct class"); is($two, $one, "Serialized and deserialized round trip"); ref_is_not($two, $one, "2 different refs"); like( dies { $CLASS->new(foo => []) }, qr/All prefixes must be defined as hashes/, "Prefixes must be hashes" ); like( dies { $CLASS->new(foo => bless({}, 'XXX')) }, qr/All prefixes must contain instances of Test2::Harness::Settings::Prefix/, "Blessed Prefixes must be prefixes" ); done_testing; ��������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/Test2/Harness/Util.t��������������������������������������������������0000644�0001750�0001750�00000005010�15012417054�021215� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util'; #BEGIN { skip_all 'TODO' } use ok $CLASS => ':ALL'; use File::Temp qw/tempfile tempdir/; imported_ok qw{ fqmod maybe_open_file maybe_read_file open_file read_file write_file write_file_atomic is_same_file }; my ($line) = split /\n/, read_file(__FILE__), 2; like( $line, q{use Test2::Bundle::Extended -target => 'Test2::Harness::Util';}, "Read file (only checking first line)" ); like( dies { read_file('/fake/file/that/must/not/exist cause I say so') }, qr{^\QCould not open file '/fake/file/that/must/not/exist cause I say so' (<)\E}, "Exception thrown when read_file used on non-existing file" ); is( maybe_read_file(__FILE__), read_file(__FILE__), "maybe_read_file reads file when it exists" ); is( maybe_read_file('/fake/file/that/must/not/exist cause I say so'), undef, "maybe_read_file is undef when file does not exist" ); ok(my $fh = open_file(__FILE__), "opened file"); ok($line = <$fh>, "Can read from file, default mode is 'read'"); if (-e '/dev/null') { ok(my $null = open_file('/dev/null', '>'), "opened /dev/null for writing"); ok((print $null "xxx\n"), "printed to /dev/null"); is( [write_file('/dev/null', "AAA", "BBB")], ["AAA", "BBB"], "wrote and returned content (/dev/null)" ); } is( maybe_open_file('/fake/file/that/must/not/exist cause I say so'), undef, "maybe_open_file is undef when file does not exist" ); is(fqmod('Foo::Bar', 'Baz'), 'Foo::Bar::Baz', "fqmod on postfix"); is(fqmod('Foo::Bar', 'Baz::Bat'), 'Foo::Bar::Baz::Bat', "fqmod on longer postfix"); is(fqmod('Foo::Bar', '+Baz'), 'Baz', "fqmod on fq"); is(fqmod('Foo::Bar', '+Baz::Bat'), 'Baz::Bat', "fqmod on longer fq"); my $tmp = tempdir(CLEANUP => 1, TMPDIR => 1); write_file_atomic(File::Spec->canonpath("$tmp/xxx"), "data"); $fh = open_file(File::Spec->canonpath("$tmp/xxx"), '<'); is(<$fh>, "data", "read data from file"); open($fh, '>', "$tmp/foo"); print $fh "\n"; close($fh); open($fh, '>', "$tmp/bar"); print $fh "\n"; close($fh); link("$tmp/foo", "$tmp/foo2") or die "Could not create link: $!"; symlink("$tmp/foo", "$tmp/foo3") or die "Could not create link: $!"; ok(is_same_file("$tmp/foo", "$tmp/foo"), "Matching filenames"); ok(is_same_file("$tmp/foo", "$tmp/foo2"), "hard link"); ok(is_same_file("$tmp/foo", "$tmp/foo3"), "soft link"); ok(!is_same_file("$tmp/foo", "$tmp/bar"), "Different files"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/App/������������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�016233� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/App/Yath/�������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�017140� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/App/Yath/Command/�����������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020516� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/App/Yath/Command/init.t�����������������������������������������������0000644�0001750�0001750�00000002131�15012417054�021643� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Command::init'; # HARNESS-DURATION-SHORT use ok $CLASS; use App::Yath::Tester qw/make_example_dir/; use Cwd qw/getcwd/; my $orig = getcwd(); subtest run => sub { my $dir = make_example_dir(); chdir($dir); unlink('test.pl') or die "Could not unlink test.pl" if -e 'test.pl'; my $stdout = ""; { local *STDOUT; open(STDOUT, '>', \$stdout); is($CLASS->run(), 0, "Exit of 0"); ok(-e 'test.pl', "Added test.pl"); is($CLASS->run(), 0, "Exit of 0 if we are updating a generated one"); unlink('test.pl') or die "Could not unlink test.pl"; open(my $fh, '>', 'test.pl') or die "Could not open test.pl"; print $fh "xx\n"; close($fh); } is( $stdout, "\nWriting test.pl...\n\n\nWriting test.pl...\n\n", "Saw write info both times" ); is( dies { $CLASS->run() }, "'test.pl' already exists, and does not appear to be a yath runner.\n", "Cannot override a non-generated test.pl" ); }; done_testing; chdir($orig); ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/App/Yath/Plugin/������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020376� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/App/Yath/Plugin/Git.script��������������������������������������������0000755�0001750�0001750�00000007422�15012417054�022357� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/env perl use strict; use warnings; my $args = join ' ' => @ARGV; my $afile = <<'EOT'; diff --git a/a.file b/a.file index a7175683..7646fa7b 100644 --- a/a.file +++ b/a.file @@ garbage @@ package A; sub sub1 { - my ($self) = @_; + my $self = shift; ... } sub sub2 { ... } +my @foo = ("X", "Y"); - sub sub3 { ... } -my @foo = ("X", "Y"); 1; EOT my $bfile = <<'EOT'; diff --git a/b.file b/b.file index a7175683..7646fa7b 100644 --- a/b.file +++ b/b.file @@ garbage @@ package B; +our $global = "yes"; sub sub1 { - my ($self) = @_; + my $self = shift; ... } sub sub2 { ... } 1; EOT my $cfile = <<'EOT'; diff --git a/c.file b/c.file index a7175683..7646fa7b 100644 --- a/c.file +++ b/c.file @@ garbage @@ package C; sub sub1 { - my ($self) = @_; + my $self = shift; ... } sub sub2 { ... } 1; EOT my %out = ( 'rev-parse HEAD' => [0, "4570988f2c2bd26a1691a82766d5bf5c7524bcea\n"], 'rev-parse --short HEAD' => [0, "4570988\n"], 'status -s' => [0, " M lib/App/Yath/Plugin/Git.pm\n"], 'rev-parse --abbrev-ref HEAD' => [0, "my.branch.foo\n"], 'merge-base --is-ancestor HEAD master' => [1, ""], 'diff HEAD --name-only' => [0, ""], 'diff -U1000000 -W --minimal HEAD' => [0, ""], 'merge-base --is-ancestor HEAD^ master' => [1, ""], 'diff HEAD^ --name-only' => [0, "a.file\n"], 'diff -U1000000 -W --minimal HEAD^' => [0, $afile], 'merge-base --is-ancestor HEAD^^ master' => [1, ""], 'diff HEAD^^ --name-only' => [0, "a.file\nb.file\n"], 'diff -U1000000 -W --minimal HEAD^^' => [0, $afile . $bfile], 'merge-base --is-ancestor HEAD^^^ master' => [0, ""], 'diff HEAD^^^ --name-only' => [0, "a.file\nb.file\nc.file\n"], 'diff -U1000000 -W --minimal HEAD^^^' => [0, $afile . $bfile . $cfile], ); if (my $res = $out{$args}) { my ($exit, $text) = @$res; print $text; exit $exit; } print STDERR "Invalid args: $args\n"; exit 1; __END__ diff --git a/lib/App/Yath/Plugin/Git.pm b/lib/App/Yath/Plugin/Git.pm index a7175683..7646fa7b 100644 --- a/lib/App/Yath/Plugin/Git.pm +++ b/lib/App/Yath/Plugin/Git.pm @@ -1,170 +1,218 @@ package App::Yath::Plugin::Git; use strict; use warnings; our $VERSION = '1.000045'; use IPC::Cmd qw/can_run/; use Test2::Harness::Util::IPC qw/run_cmd/; use parent 'App::Yath::Plugin'; use App::Yath::Options; option_group {prefix => 'git', category => "Git Options"} => sub { option change_base => ( type => 's', description => "Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base.", long_examples => [" master", " HEAD^", " df22abe4"], ); }; my $GIT_CMD = can_run('git'); sub git_cmd { $ENV{GIT_COMMAND} || $GIT_CMD } sub git_output { my $class = shift; my (@args) = @_; my $cmd = $class->git_cmd or return; my ($rh, $wh, $irh, $iwh); pipe($rh, $wh) or die "No pipe: $!"; pipe($irh, $iwh) or die "No pipe: $!"; my $pid = run_cmd(stderr => $iwh, stdout => $wh, command => [$cmd, @args]); - waitpid($pid, 0); - return if $?; close($wh); close($iwh); + + waitpid($pid, 0); + if($?) { + print STDERR <$irh>; + return; + } + close($irh); return <$rh>; } sub inject_run_data { my $class = shift; my %params = @_; my $meta = $params{meta}; my $fields = $params{fields}; my $long_sha = $ENV{GIT_LONG_SHA}; my $short_sha = $ENV{GIT_SHORT_SHA}; my $status = $ENV{GIT_STATUS}; my $branch = $ENV{GIT_BRANCH}; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/App/Yath/Plugin/SysInfo.t���������������������������������������������0000644�0001750�0001750�00000007107�15012417054�022162� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Plugin::SysInfo'; use Test2::Util qw/CAN_THREAD CAN_REALLY_FORK CAN_FORK CAN_SIGSYS/; # HARNESS-DURATION-SHORT my $control = mock $CLASS => ( override => [ hostname => sub { 'foo.bar.baz-22.superlongnamewedonotwantseen.evenlonger.holycow.net' }, ], ); local *App::Yath::Plugin::SysInfo::Config = { 'useperlio' => 'define', 'use64bitint' => 'define', 'use64bitall' => 'define', 'useithreads' => 'define', 'osname' => 'linux', 'archname' => 'x86_64-linux', 'usemultiplicity' => undef, 'version' => '1.2.3', 'uselongdouble' => undef, }; local $ENV{USER} = 'bob'; local $ENV{SHELL} = '/bin/shell'; local $ENV{TERM} = 'myterm'; my $meta = {}; my $fields = []; my $one = $CLASS->new(); $one->inject_run_data(meta => $meta, fields => $fields); is( $fields, [ { name => 'sys', details => 'foo.bar.baz-22', raw => 'foo.bar.baz-22.superlongnamewedonotwantseen.evenlonger.holycow.net', data => { hostname => 'foo.bar.baz-22.superlongnamewedonotwantseen.evenlonger.holycow.net', ipc => { can_fork => CAN_FORK(), can_really_fork => CAN_REALLY_FORK(), can_sigsys => CAN_SIGSYS(), can_thread => CAN_THREAD(), }, env => { shell => '/bin/shell', term => 'myterm', user => 'bob', }, config => { archname => 'x86_64-linux', osname => 'linux', use64bitall => 'define', use64bitint => 'define', useithreads => 'define', uselongdouble => undef, usemultiplicity => undef, useperlio => 'define', version => '1.2.3', } }, } ], "Got expected fields" ); $meta = {}; $fields = []; $one = $CLASS->new(host_short_pattern => "bar\\.baz-\\d+"); $one->inject_run_data(meta => $meta, fields => $fields); is( $fields, [ { name => 'sys', details => 'bar.baz-22', raw => 'foo.bar.baz-22.superlongnamewedonotwantseen.evenlonger.holycow.net', data => { hostname => 'foo.bar.baz-22.superlongnamewedonotwantseen.evenlonger.holycow.net', ipc => { can_fork => CAN_FORK(), can_really_fork => CAN_REALLY_FORK(), can_sigsys => CAN_SIGSYS(), can_thread => CAN_THREAD(), }, env => { shell => '/bin/shell', term => 'myterm', user => 'bob', }, config => { archname => 'x86_64-linux', osname => 'linux', use64bitall => 'define', use64bitint => 'define', useithreads => 'define', uselongdouble => undef, usemultiplicity => undef, useperlio => 'define', version => '1.2.3', } }, } ], "Got expected fields, including custom hostname short filter" ); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/App/Yath/Plugin/Git.t�������������������������������������������������0000755�0001750�0001750�00000010533�15012417054�021313� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Plugin::Git'; use Test2::Util qw/CAN_THREAD CAN_REALLY_FORK CAN_FORK CAN_SIGSYS/; # HARNESS-DURATION-SHORT use Test2::Harness::Settings; subtest NOTHING => sub { my $control = mock $CLASS => ( override => [ can_run => sub { undef }, git_cmd => sub { return }, ], ); local $ENV{GIT_COMMAND}; local $ENV{GIT_LONG_SHA}; local $ENV{GIT_SHORT_SHA}; local $ENV{GIT_STATUS}; local $ENV{GIT_BRANCH}; my $meta = {}; my $fields = []; $CLASS->inject_run_data(meta => $meta, fields => $fields); ok(!$meta->{git}, "no git added to meta"); is(@$fields, 0, "No fields added"); }; subtest ENV => sub { my $script = __FILE__; $script =~ s/\.t$/\.script/; local $ENV{GIT_COMMAND} = $script; local $ENV{GIT_LONG_SHA} = "1230988f2c2bd26a1691a82766d5bf5c7524b123"; local $ENV{GIT_SHORT_SHA} = "1230988"; local $ENV{GIT_STATUS} = " M lib/App/Yath/Command.pm"; local $ENV{GIT_BRANCH} = "my.super-long-branch-name-needs-to-be-trimmed"; my $meta = {}; my $fields = []; $CLASS->inject_run_data(meta => $meta, fields => $fields); is( $meta, { git => { branch => 'my.super-long-branch-name-needs-to-be-trimmed', sha => '1230988f2c2bd26a1691a82766d5bf5c7524b123', status => ' M lib/App/Yath/Command.pm', }, }, "Added git info to meta-data" ); is( $fields, [ { data => $meta->{git}, details => 'my.super-long-branch', name => 'git', raw => 'my.super-long-branch-name-needs-to-be-trimmed', } ], "Added git field", ); }; subtest CMD => sub { my $script = __FILE__; $script =~ s/\.t$/\.script/; local $ENV{GIT_COMMAND} = $script; local $ENV{GIT_LONG_SHA}; local $ENV{GIT_SHORT_SHA}; local $ENV{GIT_STATUS}; local $ENV{GIT_BRANCH}; my $meta = {}; my $fields = []; $CLASS->inject_run_data(meta => $meta, fields => $fields); is( $meta, { git => { branch => 'my.branch.foo', sha => '4570988f2c2bd26a1691a82766d5bf5c7524bcea', status => ' M lib/App/Yath/Plugin/Git.pm', }, }, "Added git info to meta-data" ); is( $fields, [ { data => $meta->{git}, details => 'my.branch.foo', name => 'git', raw => 'my.branch.foo', } ], "Added git field", ); }; subtest MIX => sub { my $script = __FILE__; $script =~ s/\.t$/\.script/; local $ENV{GIT_COMMAND} = $script; local $ENV{GIT_LONG_SHA} = "1230988f2c2bd26a1691a82766d5bf5c7524b123"; local $ENV{GIT_SHORT_SHA}; local $ENV{GIT_STATUS}; local $ENV{GIT_BRANCH}; my $meta = {}; my $fields = []; $CLASS->inject_run_data(meta => $meta, fields => $fields); is( $meta, { git => { branch => 'my.branch.foo', sha => '1230988f2c2bd26a1691a82766d5bf5c7524b123', status => ' M lib/App/Yath/Plugin/Git.pm', }, }, "Added git info to meta-data" ); is( $fields, [ { data => $meta->{git}, details => 'my.branch.foo', name => 'git', raw => 'my.branch.foo', } ], "Added git field", ); }; #subtest changed_files => sub { # my $settings = Test2::Harness::Settings->new(); # $settings->define_prefix('git'); # $settings->git->vivify_field('change_base'); # # my $script = __FILE__; # $script =~ s/\.t$/\.script/; # local $ENV{GIT_COMMAND} = $script; # # is( # [$CLASS->changed_files($settings)], # [['a.file', '*', 'sub1', 'sub3']], # "Got changed file" # ); # # $settings->git->field(change_base => 'master'); # is( # [$CLASS->changed_files($settings)], # [ # ['a.file', '*', 'sub1', 'sub3'], # ['b.file', '*', 'sub1'], # ['c.file', 'sub1'], # ], # "Got changed files from change_base" # ); #}; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/App/Yath/Options.t����������������������������������������������������0000644�0001750�0001750�00000061414�15012417054�020766� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Options'; require App::Yath::Command; subtest sugar => sub { package Test::Options::One; use App::Yath::Options; use Test2::V0 -target => 'App::Yath::Options'; imported_ok(qw/post option options option_group include_options/); like( dies { $CLASS->import() }, qr/Test::Options::One already has an 'options' method/, "Cannot double-import" ); isa_ok(options(), [$CLASS], "options() returns an instance"); my $line; option_group {prefix => 'foo'}, sub { option_group {category => 'uhg'}, sub { $line = __LINE__; option 'xxx' => (description => 'xxx'); option 'a_foo' => (description => 'a foo'); }; option 'outer' => (description => 'outer'); }; is( options()->all, [ { type => 'b', description => 'xxx', field => 'xxx', name => 'xxx', prefix => 'foo', title => 'xxx', category => 'uhg', trace => [__PACKAGE__, __FILE__, $line + 1], }, { type => 'b', description => 'a foo', field => 'a_foo', name => 'a-foo', prefix => 'foo', title => 'a_foo', category => 'uhg', trace => [__PACKAGE__, __FILE__, $line + 2], }, { type => 'b', description => 'outer', field => 'outer', name => 'outer', prefix => 'foo', title => 'outer', category => 'NO CATEGORY - FIX ME', trace => [__PACKAGE__, __FILE__, $line + 4], }, ], "Added options, correct traces, prefix from group, nestable", ); like( dies { option_group { builds => 'A::Fake::Module::Name' }, sub { 1 } }, qr/Can't locate A.+Fake.+Module.+Name\.pm/, "'builds' must be a valid module" ); post foo => sub { 1 }; post bar => sub { 'app-a' }, sub { 2 }; option_group {applicable => sub { 'app-b' } }, sub { post baz => sub { 3 } }; my $posts = options->post_list; like( $posts, [ ['foo'], ['bar'], ['baz'], ], "All 3 posts were listed" ); is($posts->[0]->[1], undef, "No applicability check for foo"); is($posts->[0]->[2]->(), 1, "Correct callback for foo"); is($posts->[1]->[1]->(), 'app-a', "correct applicability check for bar"); is($posts->[1]->[2]->(), 2, "Correct callback fo bar"); is($posts->[2]->[1]->(), 'app-b', "correct applicability check for baz (from group)"); is($posts->[2]->[2]->(), 3, "Correct callback fo baz"); like( dies { post foo => 1 }, qr/You must provide a callback coderef/, "Code is required" ); package Test::Options::Two; use App::Yath::Options; use Test2::V0 -target => 'App::Yath::Options'; include_options 'Test::Options::One'; is(options()->all(), Test::Options::One->options()->all(), "Included options"); }; subtest init => sub { my $one = $CLASS->new(); isa_ok($one, [$CLASS], "Created an instance"); can_ok( $one, [qw{ all lookup pre_list cmd_list post_list post_list_sorted settings args command_class pending_pre pending_cmd pending_post included set_by_cli }], "Attributes" ); like( $one, { all => [], lookup => {}, pre_list => [], cmd_list => [], post_list => [], included => {}, set_by_cli => {}, }, "Set defaults", ); isa_ok($one->settings, ['Test2::Harness::Settings'], "Generated a settings object by default"); }; subtest option => sub { my $one = $CLASS->new(); my $trace = [__PACKAGE__, __FILE__, __LINE__ + 1]; my $opt = $one->option('foo', prefix => 'pre'); isa_ok($opt, ['App::Yath::Option'], "Got an option instance"); is($opt->trace, $trace, "Injected the correct trace"); is($opt->title, 'foo', "Correct title"); is($opt->prefix, 'pre', "Correct prefix"); is($one->all, [exact_ref($opt)], "Added the option"); is($one->cmd_list, [exact_ref($opt)], "Added the option for commands"); is($one->lookup, {foo => exact_ref($opt)}, "Added option to the lookup"); }; subtest _option => sub { my $one = $CLASS->new(); my $trace = [__PACKAGE__, __FILE__, __LINE__ + 1]; my $opt = $one->_option($trace, 'foo', prefix => 'pre'); isa_ok($opt, ['App::Yath::Option'], "Got an option instance"); is($opt->trace, $trace, "Used the correct trace"); is($opt->title, 'foo', "Correct title"); is($opt->prefix, 'pre', "Correct prefix"); is($one->all, [exact_ref($opt)], "Added the option"); is($one->cmd_list, [exact_ref($opt)], "Added the option for commands"); is($one->lookup, {foo => exact_ref($opt)}, "Added option to the lookup"); }; subtest _parse_option_args => sub { my $one = $CLASS->new(); is( {$one->_parse_option_args('foo')}, {title => 'foo', type => undef}, "Parse just title" ); is( {$one->_parse_option_args('foo=b')}, {title => 'foo', type => 'b'}, "Parse title=type" ); is( {$one->_parse_option_args('foo', 'b')}, {title => 'foo', type => 'b'}, "Parse title, type" ); is( {$one->_parse_option_args('foo', type => 'b', other => 'yes')}, {title => 'foo', type => 'b', other => 'yes'}, "Parse title, %opts" ); }; subtest _parse_option_caller => sub { no warnings 'once'; local *My::Caller::A::option_prefix = sub { 'MyPrefix' }; my $one = $CLASS->new(); is( {$one->_parse_option_caller('My::Caller::A', {})}, {prefix => 'myprefix'}, "Found prefix from package, and lowercased it" ); is( {$one->_parse_option_caller('FAKE', {prefix => 'MyPrefix'})}, {prefix => 'myprefix'}, "Found prefix from proto, and lowercased it" ); like( dies { $one->_parse_option_caller('FAKE', {title => 'foo'}) }, qr/Could not find an option prefix and option is not top-level \(foo\)/, "Need a prefix" ); local @App::Yath::Command::fake::ISA = ('App::Yath::Command'); local *App::Yath::Command::fake::name = sub { 'fake' }; is( {$one->_parse_option_caller('App::Yath::Command::fake')}, {from_command => 'fake'}, "Found command, prefix not required" ); is( {$one->_parse_option_caller('App::Yath::Command::fake::Options::Foo')}, {from_command => 'fake'}, "Found command (options class for command), prefix not required" ); is( {$one->_parse_option_caller('App::Yath')}, {}, "Special case, prefix not required for App::Yath namespace" ); is( {$one->_parse_option_caller('App::Yath::Plugin::Foo')}, {from_plugin => 'App::Yath::Plugin::Foo', prefix => 'foo'}, "Automatic prefix for plugin" ); is( {$one->_parse_option_caller('App::Yath::Plugin::Foo', {prefix => 'bar'})}, {from_plugin => 'App::Yath::Plugin::Foo', prefix => 'bar'}, "Can override automatic plugin prefix" ); }; subtest include_option => sub { my $one = $CLASS->new(); like( dies { $one->include_option(bless({title => 'foo', prefix => 'pre'}, 'App::Yath::Option')) }, qr/Options must have a trace/, "Need a trace" ); my $opt = App::Yath::Option->new(title => 'foo', prefix => 'foo'); is($one->include_option($opt), exact_ref($opt), "Added, and returned the reference"); like( $one, { lookup => {foo => exact_ref($opt)}, all => [exact_ref($opt)], cmd_list => [exact_ref($opt)], }, "Added the option and indexed it" ); }; subtest _index_option => sub { my $one = $CLASS->new(); my $opt1 = App::Yath::Option->new(title => 'foo', short => 'f', alt => ['fooo', 'fo'], prefix => 'foo'); my $opt2 = App::Yath::Option->new(title => 'boo', short => 'b', alt => ['booo', 'bo'], prefix => 'foo'); is($one->_index_option($opt1), 4, "indexed into 4 slots"); is($one->_index_option($opt1), 0, "Double indexing the same opt does not explode, 0 slots"); is( $one->lookup, { f => exact_ref($opt1), fo => exact_ref($opt1), foo => exact_ref($opt1), fooo => exact_ref($opt1), }, "Index has all 4 items", ); is($one->_index_option($opt2), 4, "indexed into 4 slots"); is($one->_index_option($opt2), 0, "Double indexing the same opt does not explode, 0 slots"); is( $one->lookup, { f => exact_ref($opt1), fo => exact_ref($opt1), foo => exact_ref($opt1), fooo => exact_ref($opt1), b => exact_ref($opt2), bo => exact_ref($opt2), boo => exact_ref($opt2), booo => exact_ref($opt2), }, "Index has all items", ); my $string = $opt1->trace_string; like( dies { $one->_index_option(App::Yath::Option->new(title => 'foo', prefix => 'foo')) }, qr/Option 'foo' was already defined \(\Q$string\E\)/, "Cannot add 2 opts with the same long flag" ); like( dies { $one->_index_option(App::Yath::Option->new(title => 'xoo', alt => ['fo'], prefix => 'foo')) }, qr/Option 'fo' was already defined \(\Q$string\E\)/, "Cannot add 2 opts with the same long flag (alt)" ); like( dies { $one->_index_option(App::Yath::Option->new(title => 'zoo', short => 'f', prefix => 'foo')) }, qr/Option 'f' was already defined \(\Q$string\E\)/, "Cannot add 2 opts with the same short flag" ); }; subtest _list_option => sub { my $one = $CLASS->new(); my $opt1 = App::Yath::Option->new(title => 'foo', prefix => 'xxx'); my $opt2 = App::Yath::Option->new(title => 'bar', prefix => 'xxx', pre_command => 1); ok($one->_list_option($opt1), "listed option 1"); ok($one->_list_option($opt2), "listed option 2"); like( $one, { cmd_list => [exact_ref($opt1)], pre_list => [exact_ref($opt2)], }, "Added both options to the correct lists" ); }; subtest include => sub { my $one = $CLASS->new(post_list_sorted => 1); like( dies { $one->include() }, qr/Include must be an instance of $CLASS, got undef/, "Must specify what to include" ); like( dies { $one->include('foo') }, qr/Include must be an instance of $CLASS, got 'foo'/, "String is not a valid include" ); like( dies { $one->include($CLASS) }, qr/Include must be an instance of $CLASS, got '$CLASS'/, "Package is not a valid include" ); my $ref = []; like( dies { $one->include($ref) }, qr/Include must be an instance of $CLASS, got '\Q$ref\E'/, "A reference is not a valid include" ); bless $ref, 'XXX'; like( dies { $one->include($ref) }, qr/Include must be an instance of $CLASS, got '\Q$ref\E'/, "Must be an instance of $CLASS" ); my $two = $CLASS->new(); my $opt1 = $two->option('foo', prefix => 'bar'); my $opt2 = $two->option('baz', prefix => 'bar', pre_command => 1); my $post = sub { 1 }; $two->_post(1, undef, $post); $one->include($two); like( $one, { post_list_sorted => F(), post_list => [[1, undef, exact_ref($post)]], cmd_list => [exact_ref($opt1)], pre_list => [exact_ref($opt2)], all => [exact_ref($opt1), exact_ref($opt2)], lookup => {baz => exact_ref($opt2), foo => exact_ref($opt1)}, }, "Included options and post-callbacks from the second instance" ); }; subtest include_from => sub { my $one = $CLASS->new(post_list_sorted => 1); my $two = $CLASS->new(); my $opt1 = $two->option('foo', prefix => 'bar'); my $opt2 = $two->option('baz', prefix => 'bar', pre_command => 1); my $post = sub { 1 }; $two->_post(1, undef, $post); $two->included->{'fake'} = 2; no warnings 'once'; *Some::Fake::Package::options = sub { $two }; $one->include_from('Some::Fake::Package'); like( $one, { post_list_sorted => F(), post_list => [[1, undef, exact_ref($post)]], cmd_list => [exact_ref($opt1)], pre_list => [exact_ref($opt2)], all => [exact_ref($opt1), exact_ref($opt2)], lookup => {baz => exact_ref($opt2), foo => exact_ref($opt1)}, included => {'fake' => T(), 'Some::Fake::Package' => T()}, }, "Included options and post-callbacks from the specified package" ); like( dies { $one->include_from('Some::Other::Package') }, qr/Can't locate Some.+Other.+Package\.pm in \@INC/, "Must be a valid package" ); }; subtest populate_pre_defaults => sub { my $one = $CLASS->new(); $one->option('noo', prefix => 'x', type => 's'); $one->option('foo', prefix => 'x', pre_command => 1, type => 's'); $one->option('bar', prefix => 'x', pre_command => 1, type => 'h'); $one->option('baz', prefix => 'x', pre_command => 1, type => 's', default => 42); $one->option('bat', prefix => 'x', pre_command => 1, type => 'm', default => sub { [42] }); $one->option('ban', prefix => 'x', pre_command => 1, type => 'h', default => sub { {answer => 42} }); $one->option('bag', prefix => 'x', pre_command => 1, type => 's', default => sub { }); $one->populate_pre_defaults(); is( ${$one->settings->x}, { baz => 42, bar => {}, bat => [42], ban => {answer => 42}, # The field itself is vivified, but no value set, thus it is undef # This prevents $settings->x->foo from exploding foo => undef, # Default returned an empty list, just vivify, maybe they know what # they are doing? bag => undef, # Be explicit, this should NOT be populated, not even as undef noo => DNE(), }, "Populated fields as expected", ); }; subtest populate_cmd_defaults => sub { my $one = $CLASS->new(); $one->option('noo', prefix => 'x', pre_command => 1, type => 's'); $one->option('foo', prefix => 'x', type => 's'); $one->option('bar', prefix => 'x', type => 'h'); $one->option('baz', prefix => 'x', type => 's', default => 42); $one->option('bat', prefix => 'x', type => 'm', default => sub { [42] }); $one->option('ban', prefix => 'x', type => 'h', default => sub { {answer => 42} }); $one->option('bag', prefix => 'x', type => 's', default => sub { }); like( dies { $one->populate_cmd_defaults() }, qr/The 'command_class' attribute has not yet been set/, "Need to set command class first" ); push @App::Yath::Command::fake::ISA => 'App::Yath::Command'; $one->set_command_class('App::Yath::Command::fake'); $one->populate_cmd_defaults(); is( ${$one->settings->x}, { baz => 42, bar => {}, bat => [42], ban => {answer => 42}, # The field itself is vivified, but no value set, thus it is undef # This prevents $settings->x->foo from exploding foo => undef, # Default returned an empty list, just vivify, maybe they know what # they are doing? bag => undef, # We also process any remaining pre-command ops noo => undef, }, "Populated fields as expected", ); }; subtest set_args => sub { my $one = $CLASS->new(); ok(!$one->args, "No args yet"); $one->set_args(['foo', 'bar']); is($one->args, ['foo', 'bar'], "Set the args"); like( dies { $one->set_args(['a']) }, qr/'args' has already been set/, "Cannot set args a second time", ); is($one->args, ['foo', 'bar'], "Args did not change"); }; subtest _grab_opts => sub { my $one = $CLASS->new(); like( dies { $one->_grab_opts() }, qr/The opt_fetch callback is required/, "Need opts" ); like( dies { $one->_grab_opts(sub {[]}) }, qr/The arg type is required/, "Need arg type" ); like( dies { $one->_grab_opts(sub {[]}, 'blah') }, qr/The 'args' attribute has not yet been set/, "Need args" ); $one = $CLASS->new; my $opt1 = $one->option('foo', prefix => 'x', type => 'b', short => 'f'); my $opt2 = $one->option('bar', prefix => 'x', type => 'b', alt => ['ba']); my $opt3 = $one->option('baz', prefix => 'x', type => 's'); my $opt4 = $one->option('bat', prefix => 'x', type => 'm'); my $opt5 = $one->option('ban', prefix => 'x', type => 'd'); $one->{args} = ['-f', '--ba', 'xxx', '--baz=uhg', '--bat', 'a', '--no-foo', '--bat', 'b', '--ban=y', '--ban', 'blah', '--', '--bat', 'NO']; my @out = $one->_grab_opts('all', 'foo'); is($one->args, ['xxx', 'blah', '--', '--bat', 'NO'], "Pulled out known args, stopped at --"); is( \@out, [ [exact_ref($opt1), 'handle', 1], [exact_ref($opt2), 'handle', 1], [exact_ref($opt3), 'handle', 'uhg'], [exact_ref($opt4), 'handle', 'a'], [exact_ref($opt1), 'handle_negation'], [exact_ref($opt4), 'handle', 'b'], [exact_ref($opt5), 'handle', 'y'], [exact_ref($opt5), 'handle', 1], ], "Got actions to take" ); $one->{args} = ['-f', '--ba', 'xxx', '--baz=uhg', '--bat', 'a', '--no-foo', '--bat', 'b', '--ban=y', '--ban', 'blah', '::', '--bat', 'NO']; @out = $one->_grab_opts('all', 'foo'); is($one->args, ['xxx', 'blah', '::', '--bat', 'NO'], "Pulled out known args, stopped at ::"); is( \@out, [ [exact_ref($opt1), 'handle', 1], [exact_ref($opt2), 'handle', 1], [exact_ref($opt3), 'handle', 'uhg'], [exact_ref($opt4), 'handle', 'a'], [exact_ref($opt1), 'handle_negation'], [exact_ref($opt4), 'handle', 'b'], [exact_ref($opt5), 'handle', 'y'], [exact_ref($opt5), 'handle', 1], ], "Got actions to take" ); $one->{args} = ['-f', '--ba', 'xxx', '--baz=uhg']; like( dies { $one->_grab_opts('all', 'foo', die_at_non_opt => 1) }, qr/Invalid foo option: xxx/, "Died at non-opt", ); $one->{args} = ['-f', '--ba', 'xxx', '--xyz', '--baz=uhg']; like( dies { $one->_grab_opts('all', 'foo') }, qr/Invalid foo option: --xyz/, "Died at invalid opt", ); $one->{args} = ['-f', '--ba', 'xxx', '--xyz', '--baz=uhg']; @out = $one->_grab_opts('all', 'foo', passthrough => 1); is($one->args, ['xxx', '--xyz'], "Pulled out known args"); is( \@out, [ [exact_ref($opt1), 'handle', 1], [exact_ref($opt2), 'handle', 1], [exact_ref($opt3), 'handle', 'uhg'], ], "Got actions to take" ); }; subtest '*_command_opts' => sub { my $set_def = 0; my $control = mock $CLASS => ( override => [ populate_cmd_defaults => sub { $set_def++ }, ], ); my $one = $CLASS->new(); $one->set_command_class('App::Yath::Command'); my $opt1 = $one->option('foo', prefix => 'x', type => 'b', short => 'f'); my $opt2 = $one->option('bar', prefix => 'x', type => 'b', alt => ['ba']); my $opt3 = $one->option('baz', prefix => 'x', type => 's'); my $opt4 = $one->option('bat', prefix => 'x', type => 'm'); my $opt5 = $one->option('ban', prefix => 'x', type => 'D'); my $opt6 = $one->option('bag', prefix => 'x', type => 's', pre_command => 1); $one->{args} = ['-f', '--ba', 'xxx', '--bag=yes', '--baz=uhg', '--bat', 'a', '--no-foo', '--bat', 'b', '--ban=y', '--ban', 'blah', '--', '--bat', 'NO']; $one->grab_command_opts($one->all, 'foo'); is($one->args, ['xxx', 'blah', '--', '--bat', 'NO'], "Pulled out known args, stopped at --"); is( $one->pending_cmd, [ [exact_ref($opt1), 'handle', 1], [exact_ref($opt2), 'handle', 1], [exact_ref($opt6), 'handle', 'yes'], [exact_ref($opt3), 'handle', 'uhg'], [exact_ref($opt4), 'handle', 'a'], [exact_ref($opt1), 'handle_negation'], [exact_ref($opt4), 'handle', 'b'], [exact_ref($opt5), 'handle', 'y'], [exact_ref($opt5), 'handle', 1], ], "Got actions to take, including pre-command options that were not processed yet" ); $one->process_command_opts; is($one->pending_cmd, undef, "Nothing left to do"); is( ${$one->settings->x}, { foo => FDNE(), bar => T(), baz => 'uhg', bat => ['a', 'b'], ban => ['y', 1], bag => 'yes', }, "Set the proper settings" ); }; subtest '*_pre_command_opts' => sub { my $set_def = 0; my $control = mock $CLASS => ( override => [ populate_pre_defaults => sub { $set_def++ }, ], ); my $one = $CLASS->new(); my $opt1 = $one->option('foo', pre_command => 1, prefix => 'x', type => 'b', short => 'f'); my $opt2 = $one->option('bar', pre_command => 1, prefix => 'x', type => 'b', alt => ['ba']); my $opt3 = $one->option('baz', pre_command => 1, prefix => 'x', type => 's'); my $opt4 = $one->option('bat', pre_command => 1, prefix => 'x', type => 'm'); my $opt5 = $one->option('ban', pre_command => 1, prefix => 'x', type => 'D'); my $opt6 = $one->option('bag', pre_command => 0, prefix => 'x', type => 'd'); $one->{args} = ['-f', '--ba', '--baz=uhg', '--bat', 'a', '--no-foo', '--bat', 'b', '--ban=y', '--ban', '--bag=yes', 'xxx', 'blah', '--bat', 'NO']; $one->grab_pre_command_opts($one->all, 'foo'); is($one->args, ['--bag=yes', 'xxx', 'blah', '--bat', 'NO'], "Pulled out known args, stopped at non-opt"); is( $one->pending_pre, [ [exact_ref($opt1), 'handle', 1], [exact_ref($opt2), 'handle', 1], [exact_ref($opt3), 'handle', 'uhg'], [exact_ref($opt4), 'handle', 'a'], [exact_ref($opt1), 'handle_negation'], [exact_ref($opt4), 'handle', 'b'], [exact_ref($opt5), 'handle', 'y'], [exact_ref($opt5), 'handle', 1], ], "Got actions to take, did not grab command options" ); $one->process_pre_command_opts; is($one->pending_pre, undef, "Nothing left to do"); is( ${$one->settings->x}, { foo => FDNE(), bar => T(), baz => 'uhg', bat => ['a', 'b'], ban => ['y', 1], bag => DNE(), }, "Set the proper settings" ); }; subtest set_command_class => sub { my $one = $CLASS->new(); ok(!$one->command_class, "No command class yet"); require App::Yath::Command::test; my $cmd = bless {}, 'App::Yath::Command::test'; $one->set_command_class($cmd); is($one->command_class, 'App::Yath::Command::test', "Can set via a blessed command instance"); like( dies { $one->set_command_class() }, qr/Command class has already been set/, "Cannot change command class once set." ); ok($one->included->{'App::Yath::Command::test'}, "Included options from the command"); $one = $CLASS->new(); $one->set_command_class('App::Yath::Command::test'); is($one->command_class, 'App::Yath::Command::test', "Can set via a class name"); $one = $CLASS->new(); like( dies { $one->set_command_class('Test2::Harness::Util') }, qr/Invalid command class: Test2::Harness::Util/, "Must be a valid command class" ); }; subtest post => sub { my $one = $CLASS->new(post_list_sorted => 1); my $sub = sub { 'foo' }; $one->_post(undef, undef, $sub); ok(!$one->post_list_sorted, "List is no longer considered sorted when we add an item"); is($one->post_list, [[0, undef, exact_ref($sub)]], "Added item to post list"); like( dies { $one->process_option_post_actions }, qr/The 'args' attribute has not yet been set/, "Need args first" ); $one = $CLASS->new(); $one->set_args(['foo']); }; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/App/Yath/Plugin.t�����������������������������������������������������0000644�0001750�0001750�00000001063�15012417054�020563� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Plugin'; isa_ok($CLASS, ['Test2::Harness::Plugin'], "Subclasses Test2::Harness::Plugin"); can_ok($CLASS, ['finish'], "finish() is defined"); is([$CLASS->finish], [], "finish returns an empty list in list context"); is($CLASS->finish, undef, "finish returns undef in scalar context"); ok(!$CLASS->can('sort_files'), "sort_files is not defined by default"); ok(!$CLASS->can('sort_files_2'), "sort_files_2 is not defined by default"); ok(!$CLASS->can('handle_event'), "handle_event is not defined by default"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/App/Yath/Option.t�����������������������������������������������������0000644�0001750�0001750�00000041277�15012417054�020610� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Option'; use Test2::Harness::Settings; subtest types => sub { ok($CLASS->valid_type($_), "'$_' is a valid type") for qw/b c s m d D h H/; ok(!$CLASS->valid_type('x'), "'x' is not a valid type"); is($CLASS->canon_type($_), 'b', "Converted '$_' to 'b'") for qw/bool boolean/; is($CLASS->canon_type($_), 'c', "Converted '$_' to 'c'") for qw/count counter counting/; is($CLASS->canon_type($_), 's', "Converted '$_' to 's'") for qw/scalar string number/; is($CLASS->canon_type($_), 'm', "Converted '$_' to 'm'") for qw/multi multiple list array/; is($CLASS->canon_type($_), 'd', "Converted '$_' to 'd'") for qw/default def/; is($CLASS->canon_type($_), 'D', "Converted '$_' to 'D'") for qw/multi-def multiple-default list-default array-default/; is($CLASS->canon_type($_), 'h', "Converted '$_' to 'h'") for qw/hash/; is($CLASS->canon_type($_), 'H', "Converted '$_' to 'H'") for qw/hash-list/; for my $t (qw/s m h H/) { my $one = bless {type => $t}, $CLASS; is($one->requires_arg(), T(), "type '$t' requires an arg"); is($one->allows_arg(), T(), "type '$t' does allow an arg"); } for my $t (qw/d D/) { my $one = bless {type => $t}, $CLASS; is($one->requires_arg(), F(), "type '$t' does not require an arg"); is($one->allows_arg(), T(), "type '$t' does allow an arg"); } for my $t (qw/b c/) { my $one = bless {type => $t}, $CLASS; is($one->requires_arg(), F(), "type '$t' does not require an arg"); is($one->allows_arg(), F(), "type '$t' does not allow an arg"); } }; subtest init => sub { like( dies { $CLASS->new() }, qr/You must specify 'title' or both 'field' and 'name'/, "Need 'title', or 'field' and 'name'" ); like( dies { $CLASS->new(title => 'foo') }, qr/The 'prefix' attribute is required/, "prefix is required" ); like( dies { $CLASS->new(title => 'foo', prefix => 'xxx', alt => 'xxx') }, qr/The 'alt' attribute must be an array-ref/, "Alt, when present must be an arrayref" ); my $one = $CLASS->new(title => 'foo-bar_baz', prefix => 'xxx'); isa_ok($one, [$CLASS], "Instance of $CLASS"); is($one->title, 'foo-bar_baz', "set title"); is($one->field, 'foo_bar_baz', "field has underscores"); is($one->name, 'foo-bar-baz', "name has dashes"); is($one->type, 'b', "Default type is boolean"); $one = $CLASS->new(title => 'foo-bar_baz', prefix => 'xxx', from_plugin => 1); is($one->title, 'foo-bar_baz', "set title"); is($one->field, 'foo_bar_baz', "field has underscores"); is($one->name, 'xxx-foo-bar-baz', "name has dashes, prefix is in place if it is a plugin option"); is($one->type, 'b', "Default type is boolean"); { package Foo; Test2::Harness::Util::HashBase->import(qw/bar/); } like( dies { $CLASS->new(title => 'baz', prefix => 'xxx', builds => 'Foo') }, qr/class 'Foo' does not have a 'baz' method/, "If the option is supposed to build a specific class, make sure the class knows" ); ok($CLASS->new(title => 'bar', prefix => 'xxx', builds => 'Foo'), "Construction is fine if build package has the right method"); ok($CLASS->new(title => 'bar', prefix => 'xxx', type => 's'), "'s' is a valid type"); is($CLASS->new(title => 'bar', prefix => 'xxx', type => 'scalar')->type, 's', "'scalar' is a valid type, turns into 's'"); like( dies { $CLASS->new(title => 'bar', prefix => 'xxx', type => 'uhg') }, qr/Invalid type 'uhg'/, "Type must be valid" ); is($CLASS->new(title => 'foo', prefix => 'xxx', default => 'foo')->default, 'foo', "Simple string default is fine"); is($CLASS->new(title => 'foo', prefix => 'xxx', default => 123)->default, 123, "Simple number default is fine"); is($CLASS->new(title => 'foo', prefix => 'xxx', default => \&T)->default, exact_ref(\&T), "Can use a coderef for default"); like( dies { $CLASS->new(title => 'foo', prefix => 'xxx', default => []) }, qr/'default' must be a simple scalar, or a coderef, got a 'ARRAY/, "Cannot use a non-coderef ref as a default" ); for my $attr (qw/normalize action/) { is($CLASS->new(title => 'foo', prefix => 'xxx', $attr => \&T)->$attr, exact_ref(\&T), "Can set $attr to a coderef"); is($CLASS->new(title => 'foo', prefix => 'xxx', $attr => undef)->$attr, undef, "Can set $attr to undef"); like( dies { $CLASS->new(title => 'foo', prefix => 'xxx', $attr => []) }, qr/'$attr' must be undef, or a coderef, got 'ARRAY/, "Cannot use a non-coderef ref with $attr" ); like( dies { $CLASS->new(title => 'foo', prefix => 'xxx', $attr => 1) }, qr/'$attr' must be undef, or a coderef, got 'not a ref'/, "Cannot use a scalar with $attr" ); } $one = $CLASS->new(title => 'foo', prefix => 'xxx'); is($one->trace, array { item __PACKAGE__; item __FILE__; item __LINE__ - 1; etc; }, "Got correct trace"); is($one->category, 'NO CATEGORY - FIX ME', "Default category"); is($one->description, 'NO DESCRIPTION - FIX ME', "Default description"); like( dies { $CLASS->new(title => 'foo', prefix => 'xxx', foo => 'bar') }, qr/'foo' is not a valid option attribute/, "All construction args must be valid" ); }; subtest applicable => sub { my $options = 'foo'; my $one = $CLASS->new(title => 'foo', prefix => 'xxx'); is($one->applicable($options), T(), "Unless a callback was provided and option is always applicable."); my $args; $one = $CLASS->new(title => 'foo', prefix => 'xxx', applicable => sub {$args = [@_]; 0}); is($one->applicable($options), F(), "Used value from callback"); is($args, [exact_ref($one), $options], "Callback got the necessary args"); }; subtest long_args => sub { my $one = $CLASS->new(title => 'foo', prefix => 'xxx'); is([$one->long_args], [qw/foo/], "Got long args"); $one = $CLASS->new(title => 'foo', prefix => 'xxx', alt => [qw/a b c/]); is([$one->long_args], [qw/foo a b c/], "Got long args"); }; subtest option_slot => sub { my $one = $CLASS->new(title => 'foo', prefix => 'xxx'); my $settings = Test2::Harness::Settings->new(); ok(my $slot = $one->option_slot($settings), "Got the slot"); is($$slot, undef, "slot is a reference pointing to a scalar with an undef value"); is($settings->xxx->foo, undef, "Vivified in settings"); $$slot = 123; is($settings->xxx->foo, 123, "Setting the slotref sets it in settings"); like( dies { $one->option_slot() }, qr/A settings instance is required/, "Need to pass in settings" ); }; subtest get_default => sub { my $new = sub { $CLASS->new(title => 'foo', prefix => 'xxx', @_) }; is($new->(type => 's')->get_default, undef, "default for scalar is undef"); is($new->(type => 'd')->get_default, undef, "default for 'd' is undef"); is($new->(type => 'b')->get_default, 0, "default for boolean is 0"); is($new->(type => 'c')->get_default, 0, "default for count is 0"); is($new->(type => 'm')->get_default, [], "default for multi is an empty array"); is($new->(type => 'D')->get_default, [], "default for multi-d is an empty array"); is($new->(type => 'h')->get_default, {}, "default for hash is an empty hash"); is($new->(type => 'H')->get_default, {}, "default for multi-hash is an empty hash"); is($new->(type => 's', default => 123)->get_default, 123, "Used simple default"); is($new->(type => 's', default => sub { 'xxx' })->get_default, 'xxx', "Used default generator"); }; subtest get_normalized => sub { my $new = sub { $CLASS->new(title => 'foo', prefix => 'xxx', @_) }; is($new->(type => 'b')->get_normalized('a'), 1, "Boolean normalized to true"); is($new->(type => 'b')->get_normalized(''), 0, "Boolean normalized to false"); is($new->(type => 's')->get_normalized('foo'), 'foo', "Normalize does not change most things"); is($new->(type => 'h')->get_normalized('foo=bar'), ['foo', 'bar'], "Simple hash parse/normalize"); is($new->(type => 'h')->get_normalized('foo=bar=baz,bat'), ['foo', 'bar=baz,bat'], "Do not do anything special for 'h' values"); is($new->(type => 'h')->get_normalized('foo'), ['foo', 1], "Value is 1 if nothing is specified"); is($new->(type => 'H')->get_normalized('foo=bar'), ['foo', ['bar']], "Simple multi-hash parse/normalize"); is($new->(type => 'H')->get_normalized('foo=bar=baz,bat'), ['foo', ['bar=baz', 'bat']], "Split 'H' by comma"); is($new->(type => 'H')->get_normalized('foo'), ['foo', []], "Value is [] if nothing is specified"); }; subtest handle => sub { require App::Yath::Options; my $options = App::Yath::Options->new(); my $new = sub { $CLASS->new(title => 'foo', prefix => 'xxx', @_), Test2::Harness::Settings->new() }; my ($one, $settings) = $new->(type => 'c'); $one->handle(1, $settings, $options); is($settings->xxx->foo, 1, "increment by 1"); $one->handle('a', $settings, $options); is($settings->xxx->foo, 2, "increment by 1 again"); ($one, $settings) = $new->(type => 'm'); $one->handle('a', $settings, $options); is($settings->xxx->foo, ['a'], "Pushed value"); $one->handle('b', $settings, $options); is($settings->xxx->foo, ['a', 'b'], "Pushed value again"); ($one, $settings) = $new->(type => 'D'); $one->handle('a', $settings, $options); is($settings->xxx->foo, ['a'], "Pushed value"); $one->handle('b', $settings, $options); is($settings->xxx->foo, ['a', 'b'], "Pushed value again"); ($one, $settings) = $new->(type => 'h'); $one->handle('foo=bar', $settings, $options); is($settings->xxx->foo, {'@' => ['foo'], foo => 'bar'}, "Set value and added it to the list key"); $one->handle('foo=baz', $settings, $options); is($settings->xxx->foo, {'@' => ['foo'], foo => 'baz'}, "Reset value, not duplicated in the list key"); $one->handle('fog=baz', $settings, $options); is($settings->xxx->foo, {'@' => ['foo', 'fog'], foo => 'baz', fog => 'baz'}, "Set second key"); ($one, $settings) = $new->(type => 'H'); $one->handle('foo=bar', $settings, $options); is($settings->xxx->foo, {'@' => ['foo'], foo => ['bar']}, "Set value and added it to the list key"); $one->handle('foo=baz,bat', $settings, $options); is($settings->xxx->foo, {'@' => ['foo'], foo => ['bar', 'baz', 'bat']}, "Added more values"); $one->handle('fog', $settings, $options); is($settings->xxx->foo, {'@' => ['foo', 'fog'], foo => ['bar', 'baz', 'bat'], fog => []}, "Set second key"); my $args; ($one, $settings) = $new->(type => 'H', action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; $args = [@_]; $handler->($slot, $norm); return 'xxx'; }); is($one->handle('foo=baz,bat', $settings, $options), 'xxx', "Returned value from action"); is($settings->xxx->foo, {'@' => ['foo'], foo => ['baz', 'bat']}, "Set value via handler"); is( $args, [ $one->prefix, $one->field, "foo=baz,bat", [foo => ['baz', 'bat']], exact_ref($one->option_slot($settings)), exact_ref($settings), meta { prop reftype => 'CODE' }, exact_ref($options), ], "Got args" ); }; subtest handle_negation => sub { require App::Yath::Options; my $options = App::Yath::Options->new(); my $new = sub { $CLASS->new(title => 'foo', prefix => 'xxx', @_), Test2::Harness::Settings->new() }; for my $type (qw/b c/) { my ($one, $settings) = $new->(type => $type); $one->handle(1, $settings, $options); is($settings->xxx->foo, 1, "'$type' Is set"); $one->handle_negation($settings, $options); is($settings->xxx->foo, 0, "'$type' Cleared"); } for my $type (qw/m D/) { my ($one, $settings) = $new->(type => $type); $one->handle('abc', $settings, $options); is($settings->xxx->foo, ['abc'], "'$type' Is set"); $one->handle_negation($settings, $options); is($settings->xxx->foo, [], "'$type' Cleared"); } for my $type (qw/h H/) { my ($one, $settings) = $new->(type => $type); $one->handle('abc', $settings, $options); is($settings->xxx->foo, {'@' => ['abc'], abc => T()}, "'$type' Is set"); $one->handle_negation($settings, $options); is($settings->xxx->foo, {}, "'$type' Cleared"); } my ($one, $settings) = $new->(type => 's'); $one->handle('abc', $settings, $options); is($settings->xxx->foo, 'abc', "'s' Is set"); $one->handle_negation($settings, $options); is($settings->xxx->foo, undef, "'s' Cleared"); }; subtest trace_string => sub { my $one = $CLASS->new(prefix => 'xxx', title => 'foo', trace => ['Foo', 'foo.pm', 42]); is($one->trace_string(), "foo.pm line 42", "Valid trace string"); }; subtest cli_docs => sub { my $one = $CLASS->new( type => 'b', prefix => 'xxx', title => 'foo', short => 'F', description => 'This is foo bar baz bat gsdgdsgfsdd', ); require Test2::Util::Term; my $c = mock 'Test2::Util::Term' => ( override => [term_size => sub { 10 }], # Default to super small to make sure we do something sane ); is($one->cli_docs, "--foo, -F, --no-foo\n This is foo bar baz bat gsdgdsgfsdd", "Got docs"); $one = $CLASS->new( type => 'H', prefix => 'xxx', title => 'foo', short => 'F', description => 'This is foo bar baz bat gsdgdsgfsdd', ); chomp(my $res = <<' EOT'); --foo KEY=VAL1,VAL2,..., --foo=KEY=VAL1,VAL2,..., -F KEY=VAL1,VAL2,... -F=KEY=VAL1,VAL2,..., --no-foo This is foo bar baz bat gsdgdsgfsdd Note: Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. EOT is($one->cli_docs, $res, "Got more complex docs"); $one = $CLASS->new( type => 'H', prefix => 'xxx', title => 'foo', alt => ['bar', 'baz'], short => 'F', description => 'This is foo bar baz bat gsdgdsgfsdd', long_examples => [' KEY=VALX,VALY,...', '=KEY=VALX,VALY,...'], short_examples => [' KEY=VALX,VALY,...', '=KEY=VALX,VALY,...'], ); chomp($res = <<' EOT'); --foo KEY=VALX,VALY,..., --foo=KEY=VALX,VALY,..., --bar KEY=VALX,VALY,... --bar=KEY=VALX,VALY,..., --baz KEY=VALX,VALY,..., --baz=KEY=VALX,VALY,... -F KEY=VALX,VALY,..., -F=KEY=VALX,VALY,..., --no-foo This is foo bar baz bat gsdgdsgfsdd Note: Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. EOT is($one->cli_docs, $res, "Got more complex docs with custom examples"); }; subtest pod_docs => sub { my $one = $CLASS->new( type => 'b', prefix => 'xxx', title => 'foo', short => 'F', description => 'This is foo bar baz bat gsdgdsgfsdd', ); require Test2::Util::Term; my $c = mock 'Test2::Util::Term' => ( override => [term_size => sub { 10 }], # Default to super small to make sure we do something sane ); is($one->pod_docs, <<' EOT', "Got docs"); =item --foo =item -F =item --no-foo This is foo bar baz bat gsdgdsgfsdd EOT $one = $CLASS->new( type => 'H', prefix => 'xxx', title => 'foo', short => 'F', description => 'This is foo bar baz bat gsdgdsgfsdd', ); is($one->pod_docs, <<' EOT', "Got more complex docs"); =item --foo KEY=VAL1,VAL2,... =item --foo=KEY=VAL1,VAL2,... =item -F KEY=VAL1,VAL2,... =item -F=KEY=VAL1,VAL2,... =item --no-foo This is foo bar baz bat gsdgdsgfsdd Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. EOT $one = $CLASS->new( type => 'H', prefix => 'xxx', title => 'foo', alt => ['bar', 'baz'], short => 'F', description => 'This is foo bar baz bat gsdgdsgfsdd', long_examples => [' KEY=VALX,VALY,...', '=KEY=VALX,VALY,...'], short_examples => [' KEY=VALX,VALY,...', '=KEY=VALX,VALY,...'], ); is($one->pod_docs, <<' EOT', "Got more complex docs with custom examples"); =item --foo KEY=VALX,VALY,... =item --foo=KEY=VALX,VALY,... =item --bar KEY=VALX,VALY,... =item --bar=KEY=VALX,VALY,... =item --baz KEY=VALX,VALY,... =item --baz=KEY=VALX,VALY,... =item -F KEY=VALX,VALY,... =item -F=KEY=VALX,VALY,... =item --no-foo This is foo bar baz bat gsdgdsgfsdd Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. EOT }; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/unit/App/Yath/Util.t�������������������������������������������������������0000644�0001750�0001750�00000010772�15012417054�020251� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Util'; use Test2::Tools::Spec; use Test2::Util qw/CAN_REALLY_FORK/; use Test2::Tools::GenTemp qw/gen_temp/; use Test2::Harness::Util qw/clean_path/; use File::Temp qw/tempfile/; use Cwd qw/cwd/; use File::Spec; use App::Yath::Util qw{ find_pfile is_generated_test_pl fit_to_width isolate_stdout find_yath find_in_updir }; imported_ok qw{ find_pfile is_generated_test_pl fit_to_width isolate_stdout find_yath find_in_updir }; my $initial_dir = cwd(); after_each chdir => sub { chdir($initial_dir); }; tests find_yath => sub { local $App::Yath::Script::SCRIPT = 'foobar'; is(find_yath, 'foobar', "Use \$App::Yath::Script::SCRIPT if set"); $App::Yath::Script::SCRIPT = undef; my $tmp = gen_temp('scripts' => {'yath' => 'xxx'}); my $yath = clean_path(File::Spec->catfile($tmp, 'scripts', 'yath')); chdir($tmp); eval { chmod(0755, File::Spec->catfile($tmp, 'scripts', 'yath')); 1 } or warn $@; is(find_yath, $yath, "found yath script in scripts/ dir"); is($App::Yath::Script::SCRIPT, $yath, "cached result"); my $tmp2 = gen_temp(); chdir($tmp2); $App::Yath::Script::SCRIPT = undef; local *App::Yath::Util::Config = {}; like( dies { find_yath }, qr/Could not find yath in Config paths/, "No yath found" ); local *App::Yath::Util::Config = { scriptdir => File::Spec->catdir($tmp, 'scripts'), }; like(find_yath, qr{\Q$yath\E$}, "Found it in a config path"); }; tests isolate_stdout => sub { my ($stdout_r, $stdout_w, $stderr_r, $stderr_w); pipe($stdout_r, $stdout_w) or die "Could not open pipe: $!"; pipe($stderr_r, $stderr_w) or die "Could not open pipe: $!"; my $pid = fork; die "Could not fork" unless defined $pid; unless ($pid) { # child close($stdout_r); close($stderr_r); open(STDOUT, '>&', $stdout_w) or die "Could not redirect STDOUT"; open(STDERR, '>&', $stderr_w) or die "Could not redirect STDOUT"; my $fh = isolate_stdout(); print $fh "Should go to STDOUT\n"; print "Should go to STDERR 1\n"; print STDOUT "Should go to STDERR 2\n"; print STDERR "Should go to STDERR 3\n"; exit 0; } close($stdout_w); close($stderr_w); waitpid($pid, 0); is($?, 0, "Clean exit"); is( [<$stdout_r>], ["Should go to STDOUT\n"], "Got expected STDOUT" ); is( [<$stderr_r>], [ "Should go to STDERR 1\n", "Should go to STDERR 2\n", "Should go to STDERR 3\n", ], "Got expected STDERR" ); } if CAN_REALLY_FORK; subtest is_generated_test_pl => sub { ok(!is_generated_test_pl(__FILE__), "This is not a generated test file"); my ($fh, $name) = tempfile(UNLINK => 1); print $fh "use strict;\nuse warnings;\n# THIS IS A GENERATED YATH RUNNER TEST\ndfasdafas\n"; close($fh); ok(is_generated_test_pl($name), "Found a generated file"); }; subtest find_in_updir => sub { my $tmp = gen_temp( thefile => 'xxx', nest => { nest_a => { thefile => 'xxx' }, nest_b => {}, }, ); chdir(File::Spec->catdir($tmp, 'nest', 'nest_a')) or die "$!"; my $file = File::Spec->catfile($tmp, 'nest', 'nest_a', 'thefile'); like(find_in_updir('thefile'), qr{\Q$file\E$}, "Found file in expected spot"); chdir(File::Spec->catdir($tmp, 'nest', 'nest_b')) or die "$!"; $file = File::Spec->catfile($tmp, 'thefile'); like(find_in_updir('thefile'), qr{\Q$file\E$}, "Found file in expected spot"); }; subtest fit_to_width => sub { is(fit_to_width(100, " ", "hello there"), "hello there", "No change for short string"); is(fit_to_width(2, " ", "hello there"), "hello\nthere", "Split across multiple lines"); is( fit_to_width(20, " ", "hello there, this is a longer string that needs splitting."), "hello there, this is\na longer string that\nneeds splitting.", "Split across multiple lines" ); is( fit_to_width(100, " ", ["hello there", "this is a", "longer string that", "needs no splitting."]), "hello there this is a longer string that needs no splitting.", "Split across multiple lines" ); is( fit_to_width(50, " ", ["hello there", "this is a", "longer string that", "needs splitting."]), "hello there this is a longer string that\nneeds splitting.", "Split across multiple lines" ); }; done_testing; ������Test2-Harness-1.000158/t/unit/App/Yath.t������������������������������������������������������������0000644�0001750�0001750�00000020720�15012417054�017326� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath'; use Data::Dumper; use Carp; use App::Yath; use Test2::Harness::Util qw/clean_path/; $ENV{'YATH_SELF_TEST'} = 1; subtest init => sub { my $one = $CLASS->new(argv => [foo => 'bar']); isa_ok($one, $CLASS); isa_ok($one->settings, 'Test2::Harness::Settings'); is($one->settings->harness->script, clean_path(__FILE__), "Yath script set to this test file"); is($one->_argv, [foo => 'bar'], "Grabbed argv"); is($one->config, {}, "Default empty config"); my $two = App::Yath->new(); is($two->_argv, [], "default to empty argv"); }; { require App::Yath::Command; $INC{'App/Yath/Command/NOGEN.pm'} = __FILE__; $INC{'App/Yath/Command/GEN.pm'} = __FILE__; package App::Yath::Command::NOGEN; use App::Yath::Options; option 'verbose' => ( type => 'c', prefix => 'foo', short => 'v', ); post sub { $main::POST++ }; use Test2::Harness::Util::HashBase qw/settings argv/; our @ISA = ('App::Yath::Command'); sub run { 123 } package App::Yath::Command::GEN; our @ISA = ('App::Yath::Command::NOGEN'); sub generate_run_sub { ('ran gen_run_sub', @_) } } subtest generate_run_sub => sub { my $one = $CLASS->new(argv => ['GEN']); my @out = $one->generate_run_sub('main::RUNSUB'); is( \@out, [ 'ran gen_run_sub', 'App::Yath::Command::GEN', 'main::RUNSUB', [], exact_ref($one->settings), ['GEN'], ], "Ran command generate_run_sub with correct args" ); my $two = $CLASS->new(argv => ['NOGEN', '-vv']); $two->generate_run_sub('main::RUNSUB'); is($two->settings->foo->verbose, 2, "Set verbose with CLI args"); ok(defined(&main::RUNSUB), "Added the runsub to the provided symbol"); is(main::RUNSUB(), 123, "runsub does what we expect (runs the command run method) and we get the exit value"); is($main::POST, 1, "Ran post-process callbacks"); }; subtest run_command => sub { my $one = $CLASS->new(); my $cmd = mock {run => undef, name => 'acmd'}; is( dies { $one->run_command($cmd) }, "Command 'acmd' did not return an exit value.\n", "Command must return an exit value" ); $cmd->{run} = 12; is($one->run_command($cmd), 12, "Returned the proper exit code"); }; subtest command_class => sub { my $one = $CLASS->new(argv => ['GEN']); is($one->command_class, 'App::Yath::Command::GEN', "Got command class from args"); $one->{_command_class} = 'foo'; is($one->command_class, "foo", "A cache is used"); }; subtest load_command => sub { my $one = $CLASS->new(); is($one->load_command('GEN'), 'App::Yath::Command::GEN', "Works for valid command (inline)"); is($one->load_command('test'), 'App::Yath::Command::test', "Works for valid command (real)"); is($one->load_command('gsdfgsdfgsd', check_only => 1), undef, "Missing module is ok in 'check_only' mode"); is( dies { $one->load_command('dgfsdfgsdf') }, "yath command 'dgfsdfgsdf' not found. (did you forget to install App::Yath::Command::dgfsdfgsdf?)\n", "Correct message for missing command" ); is( dies { local @INC = (sub { die "module failed\n" }); $one->load_command('jgjgjfdfk'); }, "module failed\n", "If a module load throws an exception we pass it along" ); }; subtest load_options => sub { local @INC = (@INC, 't/lib'); my $one = $CLASS->new(); $one->settings->harness->field(no_scan_plugins => 1); my $options = $one->load_options(); is( $options->included, { 'App::Yath::Options::Debug' => 1, 'App::Yath::Options::PreCommand' => 1, }, "Included Debug and PreCommand, but not plugins" ); my $two = $CLASS->new(); $two->settings->harness->field(no_scan_plugins => 0); my @ignore = warns { $options = $two->load_options() }; like( $options->included, { 'App::Yath::Options::Debug' => 1, 'App::Yath::Options::PreCommand' => 1, 'App::Yath::Plugin::Options' => 1, }, "Included Debug and PreCommand, as well as the plugin" ); ref_is($options, $two->load_options, "Cached options result"); }; subtest process_argv => sub { local @INC = (@INC, 't/lib'); my $one = $CLASS->new( argv => [qw/-Dfoo -Dbar fake -x -y blah uhg/], config => {fake => [qw/-Dbaz -z/], other => [qw/-noop/]}, ); my @ignore = warns { is($one->process_argv(), $one->_argv, "remaining args are returned") }; is($one->command_class, 'App::Yath::Command::fake', "Set command class"); is( ${$one->settings->fake}, { x => 1, y => 1, z => 1, }, "Added 'fake' command settings" ); like( $one->settings->harness->dev_libs, bag { item qr/foo$/; item qr/bar$/; item qr/baz$/; }, "Added the dev libs" ); is($one->_argv, [qw/blah uhg/], "Remaining args"); no warnings 'once'; is($main::POST_HOOK, F(), "Did not run hook yet (requires command instance)"); }; subtest command_from_argv => sub { my $one = $CLASS->new(); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); like( warning { is($one->_command_from_argv, 'test', "Default to test") }, qr/Defaulting to the 'test' command/, "Warning about default" ); my $control = mock $CLASS => ( override => [ find_pfile => sub { 1 } ] ); like( warning { is($one->_command_from_argv, 'run', "Default to run if we have a persistence file") }, qr/Persistent runner detected, defaulting to the 'run' command/, "Warning about default" ); $control = undef; $one = $CLASS->new(argv => ['-f', '--foo', 'test', '-b', '--bar']); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); is($one->_command_from_argv(), "test", "Found 'test' command"); is($one->_argv, ['-f', '--foo', '-b', '--bar'], "Command was removed from argv"); $one = $CLASS->new(argv => ['-f', '--foo', 'hfajhdajshfj', '-b', '--bar']); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); is($one->_command_from_argv(), "hfajhdajshfj", "Found 'hfajhdajshfj' command"); is($one->_argv, ['-f', '--foo', '-b', '--bar'], "Command was removed from argv"); $one = $CLASS->new(argv => ['-f', '--foo', '--help', '-b', '--bar']); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); is($one->_command_from_argv(), "help", "Found 'help' command"); is($one->_argv, ['-f', '--foo', '-b', '--bar'], "Command was removed from argv"); $one = $CLASS->new(argv => ['-f', '--foo', '-h', '-b', '--bar']); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); is($one->_command_from_argv(), "help", "Found 'help' command"); is($one->_argv, ['-f', '--foo', '-b', '--bar'], "Command was removed from argv"); $one = $CLASS->new(argv => ['-f', '--foo', 'foo.jsonl.bz2', '-b', '--bar']); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); my @ignore = warns { is($one->_command_from_argv(), "replay", "Found 'replay' command because we got a log") }; is($one->_argv, ['-f', '--foo', 'foo.jsonl.bz2', '-b', '--bar'], "log was not removed from argv"); $one = $CLASS->new(argv => ['-f', '--foo', __FILE__, '-b', '--bar']); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); my @ignore = warns { is($one->_command_from_argv(), "test", "Found 'test' command because we got a path") }; is($one->_argv, ['-f', '--foo', __FILE__, '-b', '--bar'], "path was not removed"); }; done_testing; ������������������������������������������������Test2-Harness-1.000158/t/yath_script.t��������������������������������������������������������������0000755�0001750�0001750�00000026072�15012417054�017264� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl # HARNESS-NO-FORK use strict; use warnings; my %ORIG_INC = (%INC); @ARGV = (); my $in_section; my %sections; { local $.; my ($script) = grep { -f $_ } 'scripts/yath', '../scripts/yath'; die "Could not find yath script" unless $script; open(my $fh, '<', $script) or die "Could not open yath script: $!"; my ($tdir) = grep { -d $_ } 't/yath_script', 'yath_script'; die "Could not find the t/yath_script directory" unless $tdir; chdir("$tdir/nested") or die "Could not change directory: $!"; while (my $line = <$fh>) { die "$script uses $1, it should not" if $line =~ m/^\s*use (strict|warnings)\b.*$/; chomp($line); if ($line =~ m/^\s*# ==START TESTABLE CODE (\S+)==\s*$/) { $in_section = $1; push @{$sections{lc($in_section)}} => ("use strict;", "use warnings FATAL => 'all';", "#line " . ($. + 1) . ' "' . $script . '"'); next; } if ($line =~ m/^\s*# ==END TESTABLE CODE\s?(\S+)==\s*$/) { die "In section '$in_section' but found end of section '$1'" unless $1 eq $in_section; $sections{lc($in_section)} = join "\n" => @{delete $sections{lc($in_section)}}; $in_section = undef; } next unless $in_section; push @{$sections{lc($in_section)}} => $line; } } my @RESULTS; sub is($$;$) { push @RESULTS => ['is', [@_], [caller()]] } sub like($$;$) { push @RESULTS => ['like', [@_], [caller()]] } sub ok($;$) { push @RESULTS => ['ok', [@_], [caller()]] } our %T; sub T() { \%T } test_find_config_files(); sub test_find_config_files { my ($config, $user_config); eval delete($sections{find_config_files}) . <<' EOT' or confess $@; $config = $config_file; $user_config = $user_config_file; 1; EOT is($config, './../.yath.rc', "Found .yath.rc in a higher dir"); is($user_config, './.yath.user.rc', "Found .yath.user.rc in the current dir"); } test_parse_config_files(); sub test_parse_config_files { my ($config_args, $to_clean); my $code = delete $sections{parse_config_files}; local @ARGV = ('START', 'END'); my %CONFIG; eval <<" EOT" or die $@; my \$config_file = './../.yath.rc'; my \$user_config_file = './.yath.user.rc'; $code \$config_args = \\\@CONFIG_ARGS; \$to_clean = \\\@TO_CLEAN; 1; EOT is( $config_args, [ '-Dpre_lib', '-D=./../pre/xxx/lib', '-D=./../pre/yyy/lib', '-D=SPLIT', '--no-scan-plugins', '-Dpre_user_lib', '-D=./pre/xxx/user/lib', '-D=./pre/yyy/user/lib', ], "Got pre-args from all config files" ); is( [@ARGV], [ '-Dpre_lib', '-D=./../pre/xxx/lib', '-D=./../pre/yyy/lib', '-D=SPLIT', '--no-scan-plugins', '-Dpre_user_lib', '-D=./pre/xxx/user/lib', '-D=./pre/yyy/user/lib', 'START', 'END', ], "Prepended args to \@ARGV" ); is( {%CONFIG}, { '~' => [ '-pXXX', '-p' => 'YYY', '-pUSER_XXX', '-p' => 'USER_YYY', ], test => [ '-Itest_lib', '-I=./../test/xxx/lib', '-I' => './../test/yyy/lib', (map {('--default-search' => $_)} glob('./../../*.t')), '-xxxx', 'foo', 'bar', 'baz' => 'bat', '-Itest_user_lib', '-I=./test/xxx/user/lib', '-I' => './test/yyy/user/lib', '-user_xxxx', 'user_foo', 'user_bar', 'user_baz' => 'user_bat', ], run => [ '-Irun_lib', '-I=./../run/xxx/lib', '-I' => './../run/yyy/lib', '-xxxx', 'foo', 'bar', '-Irun_user_lib', '-I=./run/xxx/user/lib', '-I' => './run/yyy/user/lib', '-user_xxxx', 'user_foo', 'user_bar', ], }, "Parsed all command args properly" ); is( $to_clean, [ ['test', T, '-I', '=', './../test/xxx/lib'], ['test', T, '-I', ' ', './../test/yyy/lib'], (map { ['test', T, '--default-search', ' ', $_] } glob('./../../*.t')), ['run', T, '-I', '=', './../run/xxx/lib'], ['run', T, '-I', ' ', './../run/yyy/lib'], ['test', T, '-I', '=', './test/xxx/user/lib'], ['test', T, '-I', ' ', './test/yyy/user/lib'], ['run', T, '-I', '=', './run/xxx/user/lib'], ['run', T, '-I', ' ', './run/yyy/user/lib'], ], "Will come back and clean these later" ); } test_pre_parse_d_args(); sub test_pre_parse_d_args { my $code = delete $sections{pre_parse_d_args}; local @INC = ('START', 'END'); local @ARGV = ('START', '-D=aaa', '-Dbbb', '--no-scan-plugins', '--no-dev-lib', '-D', '--dev-lib', '-Dxxx', '-Dxxx', '--dev-lib=foo', '-Dbbb', '::', '-Doops', 'END'); my @DEVLIBS; my $NO_PLUGINS; my ($libs, $done); eval $code . <<' EOT' or die $@; $libs = \@libs; $done = \%done; 1; EOT is( [@ARGV], ['START', '::', '-Doops', 'END'], "Modified \@ARGV" ); is( $libs, ['lib', 'blib/lib', 'blib/arch', 'xxx', 'foo', 'bbb'], "Got expected libs" ); is( [@DEVLIBS], ['lib', 'blib/lib', 'blib/arch', 'xxx', 'foo', 'bbb'], "Got expected devlibs" ); is( [@INC], ['lib', 'blib/lib', 'blib/arch', 'xxx', 'foo', 'bbb', 'START', 'END'], "prepended libs to \@INC" ); is( $NO_PLUGINS, 1, "Set no plugins" ); is( $done, { 'lib' => 2, 'blib/lib' => 2, 'blib/arch' => 2, 'xxx' => 2, 'foo' => 1, 'bbb' => 1, }, "Saw each arg as many times as we expected (including the reset mid-way wiping previously seen out)" ); local @INC = ('START', 'END'); local @ARGV = ('START', '-Dbbb', '--', '-Doops', 'END'); @DEVLIBS = (); eval $code . <<' EOT' or die $@; $libs = \@libs; $done = \%done; 1; EOT is( [@ARGV], ['START', '--', '-Doops', 'END'], "Modified \@ARGV" ); is( $libs, ['bbb'], "Got expected libs" ); is( [@INC], ['bbb', 'START', 'END'], "prepended libs to \@INC" ); is( $done, { 'bbb' => 1, }, "Saw each arg as many times as we expected" ); } is({%INC}, {%ORIG_INC}, "Did not load anything."); require Test2::V0; # such a dirty hack! # Turn %T into an instance of the T check. my $t = Test2::V0::T(); %T = %$t; bless(\%T, ref($t)); for my $res (@RESULTS) { my ($func, $args, $caller) = @$res; my $sub = Test2::V0->can($func) or die "No such test function: $func at $caller->[1] line $caller->[2]\n"; $sub->(@$args) or warn "Actual assertion at $caller->[1] line $caller->[2]\n"; } test_cleanup_paths(); sub test_cleanup_paths { my $code = delete $sections{cleanup_paths}; require Cwd; require File::Spec; my @libs = ('../../lib', './', '../'); my @DEVLIBS = @libs; local @INC = (@libs, 'START', 'END'); my %CONFIG = ( test => [ '-I' => '../../lib', '-I=../../lib', ], ); my @TO_CLEAN = ( ['test', 1, '-I', ' ', '../../lib'], ['test', 2, '-I', '=', '../../lib'], ); eval $code . "\n1;" or die $@; Test2::V0::is( \@INC, [(map { Cwd::realpath($_) } @libs), 'START', 'END'], "Cleaned up \@INC" ); Test2::V0::is( \@DEVLIBS, [(map { Cwd::realpath($_) } @libs)], "Cleaned up \@DEVLIBS" ); Test2::V0::is( \%CONFIG, { test => [ '-I' => Cwd::realpath('../../lib'), '-I=' . Cwd::realpath('../../lib'), ], }, "Cleaned up \%CONFIG" ); } test_exec(); sub test_exec { no warnings 'once'; my $code = delete $sections{exec}; my @ORIG_ARGV = ('-xyz'); my $SCRIPT; my ($exec, $die, @warn, $ORIG_TMP, $ORIG_TMP_PERMS, $config_file, $user_config_file); my $maybe_exec = '-D'; my $res; { local *CORE::GLOBAL::exec = sub { $exec = [@_] }; local $SIG{__WARN__} = sub { push @warn => @_ }; $res = eval $code . "\n1;"; $die = $res ? $@ : undef; } Test2::V0::ok($SCRIPT, "Set SCRIPT"); Test2::V0::ok(-e $SCRIPT, "Valid path for script"); Test2::V0::ok(!$exec, "Did not exec"); Test2::V0::ok(!$die, "Did not die"); Test2::V0::ok(!@warn, "Did not warn"); $code =~ s/#line (\d+) ".*"/#line $1 "old_yath"/; { local *CORE::GLOBAL::exec = sub { $exec = [@_]; 1 }; local $SIG{__WARN__} = sub { push @warn => @_ }; $res = eval $code . "\n1;"; $die = $res ? undef : $@; } Test2::V0::like($SCRIPT, qr/old_yath$/, "Initial script is old"); Test2::V0::like($exec, [qr{scripts/yath$}, '-xyz'], "exec called new yath"); Test2::V0::like($die, qr/Should not see this, exec failed/, "Died when exec failed"); Test2::V0::like(\@warn, [qr{-D was used, and scripts/yath is present, using exec to switch to it\.}], "Warned about the exec"); } test_create_app(); sub test_create_app { my $code = delete $sections{create_app}; my $args; require App::Yath; my $control = Test2::V0::mock( 'App::Yath' => ( override => { generate_run_sub => sub { $args = [@_] }, }, ) ); my (%ORIG_SIG, @ORIG_ARGV, @ORIG_INC, @DEVLIBS, @ARGV, %CONFIG, $NO_PLUGINS, $ORIG_TMP, $ORIG_TMP_PERMS, $config_file, $user_config_file); $NO_PLUGINS = 2; my $SCRIPT = "foobar"; eval $code or die $@; my ($app, $symbol) = @$args; Test2::V0::isa_ok($app, 'App::Yath'); Test2::V0::is($symbol, 'App::Yath::Script::run', "Got correct symbol"); Test2::V0::ref_is($app->_argv, \@ARGV, "Used ARGV"); Test2::V0::ref_is($app->config, \%CONFIG, "Used CONFIG"); my $settings = $app->settings; is( $settings, { yath => { orig_sig => Test2::V0::exact_ref(\%ORIG_SIG), orig_argv => Test2::V0::exact_ref(\@ORIG_ARGV), orig_inc => Test2::V0::exact_ref(\@ORIG_INC), dev_libs => Test2::V0::exact_ref(\@DEVLIBS), script => $SCRIPT, no_scan_plugins => 2, start => Test2::V0::T(), }, }, "Got settings" ); } die "The following sections were not tested: " . join(', ', keys %sections) if keys %sections; Test2::V0::done_testing(); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/1-pod_name.t���������������������������������������������������������������0000644�0001750�0001750�00000002510�15012417054�016637� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Harness::Util qw/file2mod/; use File::Find; my @files; find(\&wanted, 'lib/'); sub wanted { my $file = $File::Find::name; return unless $file =~ m/\.pm$/; my $mod = $file; $mod =~ s{^.*lib/}{}g; $mod = file2mod($mod); push @files => [$file, $mod]; }; my %bad_files; for my $set (@files) { my ($file, $mod) = @$set; my @res; open(my $fh, '<', "$file") or die "Could not open file '$file': $!"; chomp(my $start = <$fh>); push @res => is($start, "package $mod;", "$file has correct package $mod", "Incorrect: $start"); my $found; while(my $line = <$fh>) { chomp($line); if ($line eq "=head1 POD IS AUTO-GENERATED") { $found = 1; last; } next unless $line eq '=head1 NAME'; $found = 1; my $space = <$fh> // last; chomp(my $check = <$fh> // ''); push @res => like($check, qr/^\Q$mod - \E.+$/, "$file POD has correct package '$mod' under NAME"); last; } push @res => ok($found, "Found 'NAME' section in $file POD"); next unless grep { !$_ } @res; $bad_files{$file} = $mod; }; if (keys %bad_files) { my $diag = "All files with errors:\n"; for my $file (sort keys %bad_files) { $diag .= "$file\n"; } diag $diag; } done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/0-load_all.t���������������������������������������������������������������0000644�0001750�0001750�00000001020�15012417054�016616� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Find; use Test2::Harness; use Test2::Harness::Util qw/file2mod/; find(\&wanted, 'lib/'); sub wanted { my $file = $File::Find::name; return unless $file =~ m/\.pm$/; $file =~ s{^.*lib/}{}g; my $ok = eval { require($file); 1 }; my $err = $@; ok($ok, "require $file", $ok ? () : $err); my $mod = file2mod($file); my $sym = "$mod\::VERSION"; no strict 'refs'; is($$sym, $Test2::Harness::VERSION, "Package $mod ($file) has the version number"); }; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t/HashBase.t�����������������������������������������������������������������0000644�0001750�0001750�00000013762�15012417054�016410� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; sub warnings(&) { my $code = shift; my @warnings; local $SIG{__WARN__} = sub { push @warnings => @_ }; $code->(); return \@warnings; } sub exception(&) { my $code = shift; local ($@, $!, $SIG{__DIE__}); my $ok = eval { $code->(); 1 }; my $error = $@ || 'SQUASHED ERROR'; return $ok ? undef : $error; } BEGIN { $INC{'Object/HashBase/Test/HBase.pm'} = __FILE__; package main::HBase; use Test2::Harness::Util::HashBase qw/foo bar baz/; main::is(FOO, 'foo', "FOO CONSTANT"); main::is(BAR, 'bar', "BAR CONSTANT"); main::is(BAZ, 'baz', "BAZ CONSTANT"); } BEGIN { package main::HBaseSub; use base 'main::HBase'; use Test2::Harness::Util::HashBase qw/apple pear/; main::is(FOO, 'foo', "FOO CONSTANT"); main::is(BAR, 'bar', "BAR CONSTANT"); main::is(BAZ, 'baz', "BAZ CONSTANT"); main::is(APPLE, 'apple', "APPLE CONSTANT"); main::is(PEAR, 'pear', "PEAR CONSTANT"); } my $one = main::HBase->new(foo => 'a', bar => 'b', baz => 'c'); is($one->foo, 'a', "Accessor"); is($one->bar, 'b', "Accessor"); is($one->baz, 'c', "Accessor"); $one->set_foo('x'); is($one->foo, 'x', "Accessor set"); $one->set_foo(undef); is_deeply( $one, { foo => undef, bar => 'b', baz => 'c', }, 'hash' ); BEGIN { package main::Const::Test; use Test2::Harness::Util::HashBase qw/foo/; sub do_it { if (FOO()) { return 'const'; } return 'not const' } } my $pkg = 'main::Const::Test'; is($pkg->do_it, 'const', "worked as expected"); { local $SIG{__WARN__} = sub { }; *main::Const::Test::FOO = sub { 0 }; } ok(!$pkg->FOO, "overrode const sub"); is($pkg->do_it, 'const', "worked as expected, const was constant"); BEGIN { $INC{'Object/HashBase/Test/HBase/Wrapped.pm'} = __FILE__; package main::HBase::Wrapped; use Test2::Harness::Util::HashBase qw/foo bar dup/; my $foo = __PACKAGE__->can('foo'); no warnings 'redefine'; *foo = sub { my $self = shift; $self->set_bar(1); $self->$foo(@_); }; } BEGIN { $INC{'Object/HashBase/Test/HBase/Wrapped/Inherit.pm'} = __FILE__; package main::HBase::Wrapped::Inherit; use base 'main::HBase::Wrapped'; use Test2::Harness::Util::HashBase qw/baz dup/; } my $o = main::HBase::Wrapped::Inherit->new(foo => 1); my $foo = $o->foo; is($o->bar, 1, 'parent attribute sub not overridden'); { package Foo; sub new; use Test2::Harness::Util::HashBase qw/foo bar baz/; sub new { 'foo' }; } is(Foo->new, 'foo', "Did not override existing 'new' method"); BEGIN { $INC{'Object/HashBase/Test/HBase2.pm'} = __FILE__; package main::HBase2; use Test2::Harness::Util::HashBase qw/foo -bar ^baz <bat >ban +boo/; main::is(FOO, 'foo', "FOO CONSTANT"); main::is(BAR, 'bar', "BAR CONSTANT"); main::is(BAZ, 'baz', "BAZ CONSTANT"); main::is(BAT, 'bat', "BAT CONSTANT"); main::is(BAN, 'ban', "BAN CONSTANT"); main::is(BOO, 'boo', "BOO CONSTANT"); } my $ro = main::HBase2->new(foo => 'foo', bar => 'bar', baz => 'baz', bat => 'bat', ban => 'ban'); is($ro->foo, 'foo', "got foo"); is($ro->bar, 'bar', "got bar"); is($ro->baz, 'baz', "got baz"); is($ro->bat, 'bat', "got bat"); ok(!$ro->can('set_bat'), "No setter for bat"); ok(!$ro->can('ban'), "No reader for ban"); ok(!$ro->can('boo'), "No reader for boo"); ok(!$ro->can('set_boo'), "No setter for boo"); is($ro->{ban}, 'ban', "ban attribute is set"); $ro->set_ban('xxx'); is($ro->{ban}, 'xxx', "ban attribute can be set"); is($ro->set_foo('xxx'), 'xxx', "Can set foo"); is($ro->foo, 'xxx', "got foo"); like(exception { $ro->set_bar('xxx') }, qr/'bar' is read-only/, "Cannot set bar"); my $warnings = warnings { is($ro->set_baz('xxx'), 'xxx', 'set baz') }; like($warnings->[0], qr/set_baz\(\) is deprecated/, "Deprecation warning"); is_deeply( [Test2::Harness::Util::HashBase::attr_list('main::HBase::Wrapped::Inherit')], [qw/foo bar dup baz/], "Got a list of attributes in order starting from base class, duplicates removed", ); my $x = main::HBase::Wrapped::Inherit->new(foo => 1, baz => 2); is($x->foo, 1, "set foo via pairs"); is($x->baz, 2, "set baz via pairs"); # Now with hashref my $y = main::HBase::Wrapped::Inherit->new({foo => 1, baz => 2}); is($y->foo, 1, "set foo via hashref"); is($y->baz, 2, "set baz via hashref"); # Now with hashref my $z = main::HBase::Wrapped::Inherit->new([ 1, # foo 2, # bar 3, # dup 4, # baz ]); is($z->foo, 1, "set foo via arrayref"); is($z->baz, 4, "set baz via arrayref"); like( exception { main::HBase::Wrapped::Inherit->new([1 .. 10]) }, qr/Too many arguments for main::HBase::Wrapped::Inherit constructor/, "Too many args in array form" ); my $CAN_COUNT = 0; my $CAN_COUNT2 = 0; my $INIT_COUNT = 0; BEGIN { $INC{'Object/HashBase/Test/HBase3.pm'} = __FILE__; package main::HBase3; use Test2::Harness::Util::HashBase qw/foo/; sub can { my $self = shift; $CAN_COUNT++; $self->SUPER::can(@_); } $INC{'Object/HashBase/Test/HBase4.pm'} = __FILE__; package main::HBase4; use Test2::Harness::Util::HashBase qw/foo/; sub can { my $self = shift; $CAN_COUNT2++; $self->SUPER::can(@_); } sub init { $INIT_COUNT++ } } is($CAN_COUNT, 0, "->can has not been called yet"); my $it = main::HBase3->new; is($CAN_COUNT, 1, "->can has been called once to check for init"); $it = main::HBase3->new; is($CAN_COUNT, 1, "->can was not called again, we cached it"); is($CAN_COUNT2, 0, "->can has not been called yet"); is($INIT_COUNT, 0, "->init has not been called yet"); $it = main::HBase4->new; is($CAN_COUNT2, 1, "->can has been called once to check for init"); is($INIT_COUNT, 1, "->init has been called once"); $it = main::HBase4->new; is($CAN_COUNT2, 1, "->can was not called again, we cached it"); is($INIT_COUNT, 2, "->init has been called again"); done_testing; 1; ��������������Test2-Harness-1.000158/scripts/���������������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�015760� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/scripts/yath�����������������������������������������������������������������0000755�0001750�0001750�00000021365�15012417054�016662� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl # Do not use warnings/strict, we want to avoid contamination of the # '-D' and '--dev-lib' MUST be handled well in advance of loading ANYTHING. # These will get re-processed later, but they MUST come even before App::Yath # is loaded. BEGIN { local $.; return if $^C; package App::Yath::Script; our $VERSION = '1.000156'; my $ORIG_TMP; my $ORIG_TMP_PERMS; my %ORIG_SIG = map { defined($SIG{$_}) ? ($_ => "$SIG{$_}") : ()} keys %SIG; my @ORIG_ARGV = @ARGV; my @ORIG_INC = @INC; my @DEVLIBS; my %CONFIG; my $NO_PLUGINS; our $SCRIPT; # ==START TESTABLE CODE FIND_CONFIG_FILES== my ($config_file, $user_config_file); # Would be nice if we could use File::Spec, but we cannot load ANYTHING yet. my %no_stat = (mswin32 => 1, vms => 1, riscos => 1, os2 => 1, cygwin => 1); my %seen; my $dir = './'; for (1 .. 100) { # If we are more than 100 deep we have other problems if ($no_stat{lc($^O)}) { opendir(my $dh, $dir) or die "$!"; my $key = join ':' => sort readdir($dh); last if $seen{$key}++; } else { my ($dev, $ino) = stat $dir; last if $seen{$dev}{$ino}++; } $config_file //= "${dir}.yath.rc" if -f "${dir}.yath.rc"; $user_config_file //= "${dir}.yath.user.rc" if -f "${dir}.yath.user.rc"; last if $config_file && $user_config_file; $dir .= "../"; } # ==END TESTABLE CODE FIND_CONFIG_FILES== # ==START TESTABLE CODE PARSE_CONFIG_FILES== my (@CONFIG_ARGS, @TO_CLEAN); for my $file ($config_file, $user_config_file) { next unless $file && -f $file; my $cmd; open(my $fh, '<', $file) or die "Could not open config file '$file' for reading: $!"; while (my $line = <$fh>) { chomp($line); $cmd = $1 and next if $line =~ m/^\[(.*)\]$/; $line =~ s/;.*$//g; $line =~ s/^\s*//g; $line =~ s/\s*$//g; next unless length($line); my ($key, $eq, $val); if ($line =~ m/^(-\S)((?:rel|glob|relglob)\(.*\))$/) { # Handle things like -Irel(...) $key = $1; $eq = ''; $val = $2; } else { ($key, $eq, $val) = split /(=|\s+)/, $line, 2; # Covers most cases } my $is_pre; if ($key =~ m/^-D/ || $key eq '--dev-lib') { $eq = '=' if $val; $is_pre = 1; } if ($key eq '--no-scan-plugins') { $is_pre = 1; } my $need_to_clean; if ($val && $val =~ s/(^|=)\s*rel\(\s*//) { die "Syntax error in $file line $.: Expected ')'\n" unless $val =~ s/\s*\)$//; my $path = $file; $path =~ s{[^/]*$}{}g; $val = "${path}${val}"; $need_to_clean = 1; } my @all; if ($val && $val =~ s/(^|=)\s*(rel)?glob\(\s*//) { my $rel = $2; die "Syntax error in $file line $.: Expected ')'\n" unless $val =~ s/\s*\)$//; my $path = ''; if ($rel) { $path = $file; $path =~ s{[^/]*$}{}g; } # Avoid loading File::Glob in this process... my $out = `$^X -e 'print join "\\n" => glob("${path}${val}")'`; my @vals = split /\n/, $out; @all = map {[$key, $eq, $_, 1]} @vals; } else { @all = ([$key, $eq, $val, $need_to_clean]); } for my $set (@all) { my ($key, $eq, $val, $need_to_clean) = @$set; $eq //= ''; my @parts = $eq eq '=' ? ("${key}${eq}${val}") : (grep { defined $_ } $key, $val); if ($is_pre) { push @CONFIG_ARGS => @parts; } else { $cmd //= '~'; push @{$CONFIG{$cmd}} => @parts; push @TO_CLEAN => [$cmd, $#{$CONFIG{$cmd}}, $key, $eq, $val] if $need_to_clean; } } } close($fh); } unshift @ARGV => @CONFIG_ARGS; # ==END TESTABLE CODE PARSE_CONFIG_FILES== # ==START TESTABLE CODE PRE_PARSE_D_ARGS== my (@libs, %done, @args, $maybe_exec); while (@ARGV) { my $arg = shift @ARGV; if ($arg eq '--' || $arg eq '::') { push @args => $arg; last; } if ($arg eq '--no-dev-lib') { @libs = (); %done = (); next; } if ($arg =~ m{^(?:(?:-D=?|--dev-lib=)(.*)|--dev-lib)$}) { my @add = $1 ? ($1) : (); unless (@add) { @add = ('lib', 'blib/lib', 'blib/arch'); $maybe_exec = $arg; } push @libs => grep { !$done{$_}++ } @add; next; } if ($arg eq '--no-scan-plugins') { $NO_PLUGINS = 1; next; } push @args => $arg; } @ARGV = (@args, @ARGV); unshift @INC => @libs; unshift @DEVLIBS => @libs; # ==END TESTABLE CODE PRE_PARSE_D_ARGS== # ==START TESTABLE CODE EXEC== # Now it is safe/ok to load things. require Cwd; require File::Spec; $ORIG_TMP = File::Spec->tmpdir(); $ORIG_TMP_PERMS = ((stat($ORIG_TMP))[2] & 07777); $SCRIPT = Cwd::realpath(__FILE__) // File::Spec->rel2abs(__FILE__); if ($maybe_exec && -e 'scripts/yath') { my $script = Cwd::realpath('scripts/yath') // File::Spec->rel2abs('scripts/yath'); if ($SCRIPT ne $script) { warn "\n** $maybe_exec was used, and scripts/yath is present, using exec to switch to it. **\n\n"; exec($script, @ORIG_ARGV); die("Should not see this, exec failed!"); } } # ==END TESTABLE CODE EXEC== # ==START TESTABLE CODE CLEANUP_PATHS== if (@libs || @TO_CLEAN) { for (my $i = 0; $i < @libs; $i++) { $DEVLIBS[$i] = $INC[$i] = Cwd::realpath($INC[$i]) // File::Spec->rel2abs($INC[$i]); } for my $clean (@TO_CLEAN) { my ($cmd, $idx, $key, $eq, $val) = @$clean; $val = Cwd::realpath($val) // File::Spec->rel2abs($val); if ($eq eq '=') { $CONFIG{$cmd}->[$idx] = "${key}${eq}${val}"; } else { $CONFIG{$cmd}->[$idx] = $val; } } } # ==END TESTABLE CODE CLEANUP_PATHS== # ==START TESTABLE CODE CREATE_APP== require App::Yath; require Time::HiRes; require Test2::Harness::Settings; my %mixin = (config_file => '', user_config_file => ''); $mixin{config_file} = Cwd::realpath($config_file) // File::Spec->rel2abs($config_file) if $config_file; $mixin{user_config_file} = Cwd::realpath($user_config_file) // File::Spec->rel2abs($user_config_file) if $user_config_file; my $settings = Test2::Harness::Settings->new( harness => { orig_tmp => $ORIG_TMP, orig_tmp_perms => $ORIG_TMP_PERMS, orig_sig => \%ORIG_SIG, orig_argv => \@ORIG_ARGV, orig_inc => \@ORIG_INC, script => $SCRIPT, no_scan_plugins => $NO_PLUGINS, dev_libs => \@DEVLIBS, start => Time::HiRes::time(), version => $App::Yath::VERSION, cwd => Cwd::getcwd(), %mixin, }, ); my $app = App::Yath->new( argv => \@ARGV, config => \%CONFIG, settings => $settings, ); $app->generate_run_sub('App::Yath::Script::run'); # ==END TESTABLE CODE CREATE_APP== } # Reset these if we got this far. $? = 0; $@ = ''; exit(App::Yath::Script::run()); __END__ =pod =encoding UTF-8 =head1 NAME yath - Primary Command Line Interface (CLI) for Test2::Harness =head1 DESCRIPTION This is the primary command line interface for App::Yath/Test2::Harness. Yath is essentially a shell around the components of L<Test2::Harness>. For usage instructions and examples, see L<App::Yath>. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/appveyor.yml�����������������������������������������������������������������0000644�0001750�0001750�00000001250�15012417054�016657� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������skip_tags: true cache: - C:\strawberry install: - if not exist "C:\strawberry" cinst strawberryperl -y - set PATH=C:\strawberry\perl\bin;C:\strawberry\perl\site\bin;C:\strawberry\c\bin;%PATH% - cd C:\projects\%APPVEYOR_PROJECT_NAME% - cpanm -n Dist::Zilla - dzil authordeps --missing | cpanm -n - dzil listdeps --author --missing | cpanm build_script: - perl -e 2 test_script: - dzil test notifications: - provider: Slack auth_token: secure: 1XmVVszAQyTtMdNkyWup8p7AC9iqXkMl6QMchq3Xu7L7rCzYgjjlS/mas+bfp3ouyjPKnoh01twl4eB0Xs/1Ig== channel: '#general' on_build_success: false on_build_failure: true on_build_status_changed: true ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/Makefile.PL������������������������������������������������������������������0000644�0001750�0001750�00000011420�15012417054�016241� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# This Makefile.PL for Test2-Harness was generated by # Dist::Zilla::Plugin::MakeMaker::Awesome 0.49. # Don't edit it but the dist.ini and plugins used to construct it. use strict; use warnings; use 5.010000; use ExtUtils::MakeMaker; use Config qw/%Config/; die "OS unsupported\nTest2-Harness currently only works on systems that support true forking.\n" unless $Config{d_fork}; if ($ENV{AUTOMATED_TESTING}) { my $is_njh = 0; $is_njh ||= -d '/export/home/njh'; $is_njh ||= -d '/home/njh'; $is_njh ||= lc($ENV{USER} // 'na') eq 'njh'; $is_njh ||= lc($ENV{HOME} // 'na') =~ m{njh$}; $is_njh ||= lc($ENV{PATH} // 'na') =~ m{/njh/}; die "OS unsupported\nNJH smokers are broken, aborting tests.\n" if $is_njh; } my %WriteMakefileArgs = ( "ABSTRACT" => "A new and improved test harness with better Test2 integration.", "AUTHOR" => "Chad Granum <exodist\@cpan.org>", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Test2-Harness", "EXE_FILES" => [ "scripts/yath" ], "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.010000", "NAME" => "Test2::Harness", "PREREQ_PM" => { "Carp" => 0, "Config" => 0, "Cwd" => 0, "Data::Dumper" => 0, "Data::UUID" => 0, "Exporter" => 0, "Fcntl" => 0, "File::Find" => 0, "File::Path" => "2.11", "File::Spec" => 0, "File::Temp" => 0, "Filter::Util::Call" => 0, "IO::Compress::Bzip2" => 0, "IO::Compress::Gzip" => 0, "IO::Handle" => "1.27", "IO::Uncompress::Bunzip2" => 0, "IO::Uncompress::Gunzip" => 0, "IPC::Cmd" => 0, "Importer" => "0.025", "JSON::PP" => 0, "List::Util" => "1.44", "Long::Jump" => "0.000001", "POSIX" => 0, "Scalar::Util" => 0, "Scope::Guard" => 0, "Symbol" => 0, "Sys::Hostname" => 0, "Term::Table" => "0.015", "Test2" => "1.302170", "Test2::API" => "1.302170", "Test2::Bundle::Extended" => "0.000127", "Test2::Event" => "1.302170", "Test2::Event::V2" => "1.302170", "Test2::Formatter" => "1.302170", "Test2::Plugin::MemUsage" => "0.002003", "Test2::Plugin::UUID" => "0.002001", "Test2::Tools::AsyncSubtest" => "0.000127", "Test2::Tools::Subtest" => "0.000127", "Test2::Util" => "1.302170", "Test2::Util::Term" => "0.000127", "Test2::V0" => "0.000127", "Test::Builder" => "1.302170", "Test::Builder::Formatter" => "1.302170", "Test::More" => "1.302170", "Text::ParseWords" => 0, "Time::HiRes" => 0, "YAML::Tiny" => 0, "base" => 0, "constant" => 0, "goto::file" => "0.005", "parent" => 0 }, "TEST_REQUIRES" => { "File::Copy" => 0 }, "VERSION" => "1.000158", "test" => { "TESTS" => "t/*.t t/integration/*.t t/integration/signals/*.t t/unit/App/*.t t/unit/App/Yath/*.t t/unit/App/Yath/Command/*.t t/unit/App/Yath/Plugin/*.t t/unit/Test2/Harness/*.t t/unit/Test2/Harness/Runner/*.t t/unit/Test2/Harness/Runner/Resource/SharedJobSlots/*.t t/unit/Test2/Harness/Settings/*.t t/unit/Test2/Harness/Util/*.t t/unit/Test2/Harness/Util/File/*.t t/unit/Test2/Tools/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Config" => 0, "Cwd" => 0, "Data::Dumper" => 0, "Data::UUID" => 0, "Exporter" => 0, "Fcntl" => 0, "File::Copy" => 0, "File::Find" => 0, "File::Path" => "2.11", "File::Spec" => 0, "File::Temp" => 0, "Filter::Util::Call" => 0, "IO::Compress::Bzip2" => 0, "IO::Compress::Gzip" => 0, "IO::Handle" => "1.27", "IO::Uncompress::Bunzip2" => 0, "IO::Uncompress::Gunzip" => 0, "IPC::Cmd" => 0, "Importer" => "0.025", "JSON::PP" => 0, "List::Util" => "1.44", "Long::Jump" => "0.000001", "POSIX" => 0, "Scalar::Util" => 0, "Scope::Guard" => 0, "Symbol" => 0, "Sys::Hostname" => 0, "Term::Table" => "0.015", "Test2" => "1.302170", "Test2::API" => "1.302170", "Test2::Bundle::Extended" => "0.000127", "Test2::Event" => "1.302170", "Test2::Event::V2" => "1.302170", "Test2::Formatter" => "1.302170", "Test2::Plugin::MemUsage" => "0.002003", "Test2::Plugin::UUID" => "0.002001", "Test2::Tools::AsyncSubtest" => "0.000127", "Test2::Tools::Subtest" => "0.000127", "Test2::Util" => "1.302170", "Test2::Util::Term" => "0.000127", "Test2::V0" => "0.000127", "Test::Builder" => "1.302170", "Test::Builder::Formatter" => "1.302170", "Test::More" => "1.302170", "Text::ParseWords" => 0, "Time::HiRes" => 0, "YAML::Tiny" => 0, "base" => 0, "constant" => 0, "goto::file" => "0.005", "parent" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION('6.63_03') } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/README.md��������������������������������������������������������������������0000644�0001750�0001750�00000041136�15012417054�015555� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# NAME App::Yath - Yet Another Test Harness (Test2-Harness) Command Line Interface (CLI) # DESCRIPTION This is the primary documentation for `yath`, [App::Yath](https://metacpan.org/pod/App%3A%3AYath), [Test2::Harness](https://metacpan.org/pod/Test2%3A%3AHarness). The canonical source of up-to-date command options are the help output when using `$ yath help` and `$ yath help COMMAND`. This document is mainly an overview of `yath` usage and common recipes. [App::Yath](https://metacpan.org/pod/App%3A%3AYath) is an alternative to [App::Prove](https://metacpan.org/pod/App%3A%3AProve), and [Test2::Harness](https://metacpan.org/pod/Test2%3A%3AHarness) is an alternative to [Test::Harness](https://metacpan.org/pod/Test%3A%3AHarness). It is not designed to replace [Test::Harness](https://metacpan.org/pod/Test%3A%3AHarness)/prove. [Test2::Harness](https://metacpan.org/pod/Test2%3A%3AHarness) is designed to take full advantage of the rich data [Test2](https://metacpan.org/pod/Test2) can provide. [Test2::Harness](https://metacpan.org/pod/Test2%3A%3AHarness) is also able to use non-core modules and provide more functionality than prove can achieve with its restrictions. # PLATFORM SUPPORT [Test2::Harness](https://metacpan.org/pod/Test2%3A%3AHarness)/[App::Yath](https://metacpan.org/pod/App%3A%3AYath) is is focused on unix-like platforms. Most development happens on linux, but bsd, macos, etc should work fine as well. Patches are welcome for any/all platforms, but the primary author (Chad 'Exodist' Granum) does not directly develop against non-unix platforms. ## WINDOWS Currently windows is not supported, and it is known that the package will not install on windows. Patches are be welcome, and it would be great if someone wanted to take on the windows-support role, but it is not a primary goal for the project. # OVERVIEW To use [Test2::Harness](https://metacpan.org/pod/Test2%3A%3AHarness), you use the `yath` command. Yath will find the tests (or use the ones you specify) and run them. As it runs, it will output diagnostic information such as failures. At the end, yath will print a summary of the test run. `yath` can be thought of as a more powerful alternative to `prove` ([Test::Harness](https://metacpan.org/pod/Test%3A%3AHarness)) # RECIPES These are common recipes for using `yath`. ## RUN PROJECT TESTS $ yath Simply running yath with no arguments means "Run all tests for the current project". Yath will look for tests in `./t`, `./t2`, and `./test.pl` and run any which are found. Normally this implies the `test` command but will instead imply the `run` command if a persistent test runner is detected. ## PRELOAD MODULES Yath has the ability to preload modules. Yath normally forks to start new tests, so preloading can reduce the time spent loading modules over and over in each test. Note that some tests may depend on certain modules not being loaded. In these cases you can add the `# HARNESS-NO-PRELOAD` directive to the top of the test files that cannot use preload. ### SIMPLE PRELOAD Any module can be preloaded: $ yath -PMoose You can preload as many modules as you want: $ yath -PList::Util -PScalar::Util ### COMPLEX PRELOAD If your preload is a subclass of [Test2::Harness::Runner::Preload](https://metacpan.org/pod/Test2%3A%3AHarness%3A%3ARunner%3A%3APreload) then more complex preload behavior is possible. See those docs for more info. ## LOGGING ### RECORDING A LOG You can turn on logging with a flag. The filename of the log will be printed at the end. $ yath -L ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl The event log can be quite large. It can be compressed with bzip2. $ yath -B ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 gzip compression is also supported. $ yath -G ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.gz `-B` and `-G` both imply `-L`. ### REPLAYING FROM A LOG You can replay a test run from a log file: $ yath test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 This will be significantly faster than the initial run as no tests are actually being executed. All events are simply read from the log, and processed by the harness. You can change display options and limit rendering/processing to specific test jobs from the run: $ yath test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 -v [TEST UUID(S)] Note: This is done using the `$ yath replay ...` command. The `replay` command is implied if the first argument is a log file. ## PER-TEST TIMING DATA The `-T` option will cause each test file to report how long it took to run. $ yath -T ( PASSED ) job 1 t/yath_script.t ( TIME ) job 1 Startup: 0.07692s | Events: 0.01170s | Cleanup: 0.00190s | Total: 0.09052s ## PERSISTENT RUNNER yath supports starting a yath session that waits for tests to run. This is very useful when combined with preload. ### STARTING This starts the server. Many options available to the 'test' command will work here but not all. See `$ yath help start` for more info. $ yath start ### RUNNING This will run tests using the persistent runner. By default, it will search for tests just like the 'test' command. Many options available to the `test` command will work for this as well. See `$ yath help run` for more details. $ yath run ### STOPPING Stopping a persistent runner is easy. $ yath stop ### INFORMATIONAL The `which` command will tell you which persistent runner will be used. Yath searches for the persistent runner in the current directory, then searches in parent directories until it either hits the root directory, or finds the persistent runner tracking file. $ yath which The `watch` command will tail the runner's log files. $ yath watch ### PRELOAD + PERSISTENT RUNNER You can use preloads with the `yath start` command. In this case, yath will track all the modules pulled in during preload. If any of them change, the server will reload itself to bring in the changes. Further, modified modules will be blacklisted so that they are not preloaded on subsequent reloads. This behavior is useful if you are actively working on a module that is normally preloaded. ## MAKING YOUR PROJECT ALWAYS USE YATH $ yath init The above command will create `test.pl`. `test.pl` is automatically run by most build utils, in which case only the exit value matters. The generated `test.pl` will run `yath` and execute all tests in the `./t` and/or `./t2` directories. Tests in `./t` will ALSO be run by prove but tests in `./t2` will only be run by yath. ## PROJECT-SPECIFIC YATH CONFIG You can write a `.yath.rc` file. The file format is very simple. Create a `[COMMAND]` section to start the configuration for a command and then provide any options normally allowed by it. When `yath` is run inside your project, it will use the config specified in the rc file, unless overridden by command line options. **Note:** You can also add pre-command options by placing them at the top of your config file _BEFORE_ any `[cmd]` markers. Comments start with a semi-colon. Example .yath.rc: -pFoo ; Load the 'foo' plugin before dealing with commands. [test] -B ;Always write a bzip2-compressed log [start] -PMoose ;Always preload Moose with a persistent runner This file is normally committed into the project's repo. ### SPECIAL PATH PSEUDO-FUNCTIONS Sometimes you want to specify files relative to the .yath.rc so that the config option works from any subdirectory of the project. Other times you may wish to use a shell expansion. Sometimes you want both! - rel(path/to/file) -I rel(path/to/extra_lib) -I=rel(path/to/extra_lib) This will take the path to `.yath.rc` and prefix it to the path inside `rel(...)`. If for example you have `/project/.yath.rc` then the path would become `/project/path/to/extra_lib`. - glob(path/\*/file) --default-search glob(subprojects/*/t) --default-search=glob(subprojects/*/t) This will add a `--default-search $_` for every item found in the glob. This uses the perl builtin function `glob()` under the hood. - relglob(path/\*/file) --default-search relglob(subprojects/*/t) --default-search=relglob(subprojects/*/t) Same as `glob()` except paths are relative to the `.yath.rc` file. ## PROJECT-SPECIFIC YATH CONFIG USER OVERRIDES You can add a `.yath.user.rc` file. Format is the same as the regular `.yath.rc` file. This file will be read in addition to the regular config file. Directives in this file will come AFTER the directives in the primary config so it may be used to override config. This file should not normally be committed to the project repo. ## HARNESS DIRECTIVES INSIDE TESTS `yath` will recognise a number of directive comments placed near the top of test files. These directives should be placed after the `#!` line but before any real code. Real code is defined as any line that does not start with use, require, BEGIN, package, or # - good example 1 #!/usr/bin/perl # HARNESS-NO-FORK ... - good example 2 #!/usr/bin/perl use strict; use warnings; # HARNESS-NO-FORK ... - bad example 1 #!/usr/bin/perl # blah # HARNESS-NO-FORK ... - bad example 2 #!/usr/bin/perl print "hi\n"; # HARNESS-NO-FORK ... ### HARNESS-NO-PRELOAD #!/usr/bin/perl # HARNESS-NO-PRELOAD Use this if your test will fail when modules are preloaded. This will tell yath to start a new perl process to run the script instead of forking with preloaded modules. Currently this implies HARNESS-NO-FORK, but that may not always be the case. ### HARNESS-NO-FORK #!/usr/bin/perl # HARNESS-NO-FORK Use this if your test file cannot run in a forked process, but instead must be run directly with a new perl process. This implies HARNESS-NO-PRELOAD. ### HARNESS-NO-STREAM `yath` usually uses the [Test2::Formatter::Stream](https://metacpan.org/pod/Test2%3A%3AFormatter%3A%3AStream) formatter instead of TAP. Some tests depend on using a TAP formatter. This option will make `yath` use [Test2::Formatter::TAP](https://metacpan.org/pod/Test2%3A%3AFormatter%3A%3ATAP) or [Test::Builder::Formatter](https://metacpan.org/pod/Test%3A%3ABuilder%3A%3AFormatter). ### HARNESS-NO-IO-EVENTS `yath` can be configured to use the [Test2::Plugin::IOEvents](https://metacpan.org/pod/Test2%3A%3APlugin%3A%3AIOEvents) plugin. This plugin replaces STDERR and STDOUT in your test with tied handles that fire off proper [Test2::Event](https://metacpan.org/pod/Test2%3A%3AEvent)'s when they are printed to. Most of the time this is not an issue, but any fancy tests or modules which do anything with STDERR or STDOUT other than print may have really messy errors. **Note:** This plugin is disabled by default, so you only need this directive if you enable it globally but need to turn it back off for select tests. ### HARNESS-NO-TIMEOUT `yath` will usually kill a test if no events occur within a timeout (default 60 seconds). You can add this directive to tests that are expected to trip the timeout, but should be allowed to continue. NOTE: you usually are doing the wrong thing if you need to set this. See: `HARNESS-TIMEOUT-EVENT`. ### HARNESS-TIMEOUT-EVENT 60 `yath` can be told to alter the default event timeout from 60 seconds to another value. This is the recommended alternative to HARNESS-NO-TIMEOUT ### HARNESS-TIMEOUT-POSTEXIT 15 `yath` can be told to alter the default POSTEXIT timeout from 15 seconds to another value. Sometimes a test will fork producing output in the child while the parent is allowed to exit. In these cases we cannot rely on the original process exit to tell us when a test is complete. In cases where we have an exit, and partial output (assertions with no final plan, or a plan that has not been completed) we wait for a timeout period to see if any additional events come into ### HARNESS-DURATION-LONG This lets you tell `yath` that the test file is long-running. This is primarily used when concurrency is turned on in order to run longer tests earlier, and concurrently with shorter ones. There is also a `yath` option to skip all long tests. This duration is set automatically if HARNESS-NO-TIMEOUT is set. ### HARNESS-DURATION-MEDIUM This lets you tell `yath` that the test is medium. This is the default duration. ### HARNESS-DURATION-SHORT This lets you tell `yath` That the test is short. ### HARNESS-CATEGORY-ISOLATION This lets you tell `yath` that the test cannot be run concurrently with other tests. Yath will hold off and run these tests one at a time after all other tests. ### HARNESS-CATEGORY-IMMISCIBLE This lets you tell `yath` that the test cannot be run concurrently with other tests of this class. This is helpful when you have multiple tests which would otherwise have to be run sequentially at the end of the run. Yath prioritizes running these tests above HARNESS-CATEGORY-LONG. ### HARNESS-CATEGORY-GENERAL This is the default category. ### HARNESS-CONFLICTS-XXX This lets you tell `yath` that no other test of type XXX can be run at the same time as this one. You are able to set multiple conflict types and `yath` will honor them. XXX can be replaced with any type of your choosing. NOTE: This directive does not alter the category of your test. You are free to mark the test with LONG or MEDIUM in addition to this marker. ### HARNESS-JOB-SLOTS 2 ### HARNESS-JOB-SLOTS 1 10 Specify a range of job slots needed for the test to run. If set to a single value then the test will only run if it can have the specified number of slots. If given a range the test will require at least the lower number of slots, and use up to the maximum number of slots. - Example with multiple lines. #!/usr/bin/perl # DASH and space are split the same way. # HARNESS-CONFLICTS-DAEMON # HARNESS-CONFLICTS MYSQL ... - Or on a single line. #!/usr/bin/perl # HARNESS-CONFLICTS DAEMON MYSQL ... ### HARNESS-RETRY-n This lets you specify a number (minimum n=1) of retries on test failure for a specific test. HARNESS-RETRY-1 means a failing test will be run twice and is equivalent to HARNESS-RETRY. ### HARNESS-NO-RETRY Use this to avoid this test being retried regardless of your retry settings. # MODULE DOCS This section documents the [App::Yath](https://metacpan.org/pod/App%3A%3AYath) module itself. ## SYNOPSIS In practice you should never need to write your own yath script, or construct an [App::Yath](https://metacpan.org/pod/App%3A%3AYath) instance, or even access themain instance when yath is running. However some aspects of doing so are documented here for completeness. A minimum yath script looks like this: BEGIN { package App::Yath:Script; require Time::HiRes; require App::Yath; require Test2::Harness::Settings; my $settings = Test2::Harness::Settings->new( harness => { orig_argv => [@ARGV], orig_inc => [@INC], script => __FILE__, start => Time::HiRes::time(), version => $App::Yath::VERSION, }, ); my $app = App::Yath->new( argv => \@ARGV, config => {}, settings => $settings, ); $app->generate_run_sub('App::Yath::Script::run'); } exit(App::Yath::Script::run()); It is important that most logic live in a BEGIN block. This is so that [goto::file](https://metacpan.org/pod/goto%3A%3Afile) can be used post-fork to execute a test script. The actual yath script is significantly more complicated with the following behaviors: - pre-process essential arguments such as -D and no-scan-plugins - re-exec with a different yath script if in developer mode and a local copy is found - Parse the yath-rc config files - gather and store essential startup information ## METHODS App::Yath does not provide many methods to use externally. - $app->generate\_run\_sub($symbol\_name) This tells App::Yath to generate a subroutine at the specified symbol name which can be run and be expected to return an exit value. - $lib\_path = $app->app\_path() Get the include directory App::Yath was loaded from. # SOURCE The source code repository for Test2-Harness can be found at `http://github.com/Test-More/Test2-Harness/`. # MAINTAINERS - Chad Granum <exodist@cpan.org> # AUTHORS - Chad Granum <exodist@cpan.org> # COPYRIGHT Copyright 2020 Chad Granum <exodist7@gmail.com>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See `http://dev.perl.org/licenses/` ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/META.json��������������������������������������������������������������������0000644�0001750�0001750�00000007325�15012417054�015721� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{ "abstract" : "A new and improved test harness with better Test2 integration.", "author" : [ "Chad Granum <exodist@cpan.org>" ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.032, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Test2-Harness", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Test2::Require::Module" : "0.000127", "Test::Pod" : "1.41", "Test::Spelling" : "0.12" } }, "runtime" : { "requires" : { "Carp" : "0", "Config" : "0", "Cwd" : "0", "Data::Dumper" : "0", "Data::UUID" : "0", "Exporter" : "0", "Fcntl" : "0", "File::Find" : "0", "File::Path" : "2.11", "File::Spec" : "0", "File::Temp" : "0", "Filter::Util::Call" : "0", "IO::Compress::Bzip2" : "0", "IO::Compress::Gzip" : "0", "IO::Handle" : "1.27", "IO::Uncompress::Bunzip2" : "0", "IO::Uncompress::Gunzip" : "0", "IPC::Cmd" : "0", "Importer" : "0.025", "JSON::PP" : "0", "List::Util" : "1.44", "Long::Jump" : "0.000001", "POSIX" : "0", "Scalar::Util" : "0", "Scope::Guard" : "0", "Symbol" : "0", "Sys::Hostname" : "0", "Term::Table" : "0.015", "Test2" : "1.302170", "Test2::API" : "1.302170", "Test2::Bundle::Extended" : "0.000127", "Test2::Event" : "1.302170", "Test2::Event::V2" : "1.302170", "Test2::Formatter" : "1.302170", "Test2::Plugin::MemUsage" : "0.002003", "Test2::Plugin::UUID" : "0.002001", "Test2::Tools::AsyncSubtest" : "0.000127", "Test2::Tools::Subtest" : "0.000127", "Test2::Util" : "1.302170", "Test2::Util::Term" : "0.000127", "Test2::V0" : "0.000127", "Test::Builder" : "1.302170", "Test::Builder::Formatter" : "1.302170", "Test::More" : "1.302170", "Text::ParseWords" : "0", "Time::HiRes" : "0", "YAML::Tiny" : "0", "base" : "0", "constant" : "0", "goto::file" : "0.005", "parent" : "0", "perl" : "5.010000" }, "suggests" : { "Cpanel::JSON::XS" : "0", "Email::Stuffer" : "0.016", "HTTP::Tiny" : "0.070", "HTTP::Tiny::Multipart" : "0.08", "IO::Pager" : "1.00", "JSON::MaybeXS" : "0", "Term::ANSIColor" : "4.03", "Test2::Plugin::Cover" : "0.000025", "Test2::Plugin::DBIProfile" : "0.002002", "Test2::Plugin::IOEvents" : "0.001001", "Win32::Console::ANSI" : "0" } }, "test" : { "requires" : { "File::Copy" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/Test-More/Test2-Harness/issues" }, "repository" : { "type" : "git", "url" : "https://github.com/Test-More/Test2-Harness/" } }, "version" : "1.000158", "x_generated_by_perl" : "v5.40.1", "x_serialization_backend" : "Cpanel::JSON::XS version 4.39", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/��������������������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�014616� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/lib/����������������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�015364� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/lib/App/������������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�016104� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/lib/App/Yath/�������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�017011� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/lib/App/Yath/Plugin/������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�020247� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/lib/App/Yath/Plugin/SelfTest.pm�������������������������������������������0000644�0001750�0001750�00000001275�15012417054�022343� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin::SelfTest; use strict; use warnings; use Test2::Harness::TestFile; use IPC::Cmd qw/can_run/; use parent 'App::Yath::Plugin'; sub find_files { my ($plugin, $run, $search) = @_; return if ($search && !grep { m{^(./)?t2(/non_perl(/(.*)?)?)?} } @$search); my @out; if (can_run('/usr/bin/bash')) { push @out => Test2::Harness::TestFile->new(file => "t2/non_perl/test.sh"); } if (can_run('gcc')) { system('gcc', '-o' => 't2/non_perl/test.binary', 't2/non_perl/test.c') and die "Failed to compile t2/non_perl/test.c"; push @out => Test2::Harness::TestFile->new(file => "t2/non_perl/test.binary"); } return @out; } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/relative_paths_no_fork.t��������������������������������������������������0000644�0001750�0001750�00000000640�15012417054�021532� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; # HARNESS-NO-FORK # HARNESS-DURATION-SHORT my $path = File::Spec->canonpath('t2/relative_paths_no_fork.t'); skip_all "This test must be run from the project root." unless -f $path; is(__FILE__, $path, "__FILE__ is relative"); is(__FILE__, $0, "\$0 is relative"); sub { my ($pkg, $file) = caller(0); is($file, $path, "file in caller is relative"); }->(); done_testing; ������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/subtests_streamed.t�������������������������������������������������������0000644�0001750�0001750�00000000377�15012417054�020552� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# HARNESS-NO-STREAM use strict; use warnings; use Test2::Tools::Tiny; use Test2::Tools::Subtest qw/subtest_streamed/; # HARNESS-DURATION-SHORT subtest_streamed foo => sub { subtest_streamed bar => sub { ok(1, 'baz'); }; }; done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/subtests_buffered.t�������������������������������������������������������0000644�0001750�0001750�00000000377�15012417054�020530� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# HARNESS-NO-STREAM use strict; use warnings; use Test2::Tools::Tiny; use Test2::Tools::Subtest qw/subtest_buffered/; # HARNESS-DURATION-SHORT subtest_buffered foo => sub { subtest_buffered bar => sub { ok(1, 'baz'); }; }; done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/relative_paths.t����������������������������������������������������������0000644�0001750�0001750�00000000606�15012417054�020017� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; # HARNESS-DURATION-SHORT my $path = File::Spec->canonpath('t2/relative_paths.t'); skip_all "This test must be run from the project root." unless -f $path; is(__FILE__, $path, "__FILE__ is relative"); is(__FILE__, $0, "\$0 is relative"); sub { my ($pkg, $file) = caller(0); is($file, $path, "file in caller is relative"); }->(); done_testing; ��������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/require_file.pm�����������������������������������������������������������0000644�0001750�0001750�00000000142�15012417054�017624� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; sub file_loaded { 1 } is(__PACKAGE__, 'main', "in main package"); 1; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/non_perl/�����������������������������������������������������������������0000755�0001750�0001750�00000000000�15012417054�016432� 5����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/non_perl/test.sh����������������������������������������������������������0000755�0001750�0001750�00000000113�15012417054�017743� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/bash # HARNESS-DURATION-SHORT echo "ok 1"; echo "1..1"; exit 0; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/non_perl/test.c�����������������������������������������������������������0000755�0001750�0001750�00000000150�15012417054�017554� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <stdio.h> int main() { printf("ok 1 - assertion\n"); printf("1..1\n"); return 0; } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/no_stdout_eol.t�����������������������������������������������������������0000644�0001750�0001750�00000000132�15012417054�017654� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl use strict; use warnings; # HARNESS-DURATION-SHORT print "1..2\nok\nok"; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/require_file.t������������������������������������������������������������0000644�0001750�0001750�00000000404�15012417054�017454� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test2::Tools::Tiny; use File::Spec; # HARNESS-DURATION-SHORT my $file = __FILE__; $file =~ s/\.t$/.pm/; $file = File::Spec->rel2abs($file); require $file; ok(file_loaded(), "file loaded, proper namespace, etc"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/magic_vars.t��������������������������������������������������������������0000644�0001750�0001750�00000000273�15012417054�017120� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-DURATION-SHORT skip_all "Test breaks Devel::Cover db" if $ENV{T2_DEVEL_COVER}; $\ = '|'; $, = '|'; is($\, '|', 'set $\\'); is($,, '|', 'set $,'); done_testing �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/ipc_reexec.t��������������������������������������������������������������0000644�0001750�0001750�00000000442�15012417054�017111� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# HARNESS-NO-FORK # HARNESS-DURATION-SHORT BEGIN { $INC{'Test2/Formatter/Stream.pm'} && exec($^X, $0); }; # Force into stdout BEGIN { delete $ENV{T2_STREAM_DIR}; delete $ENV{T2_FORMATTER}; } use Test::Builder; use Test2::V0; ok 1, "test runs correctly in IPC mode"; done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/tmp_perms.t���������������������������������������������������������������0000644�0001750�0001750�00000002154�15012417054�017013� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; use Test2::Harness::Util qw/clean_path/; use Fcntl ':mode'; sub check_perms { my $file = shift; my $mode = (stat($file))[2]; my @bad; $mode & S_ISVTX or push @bad => "$file does not have sticky-bit"; $mode & S_IRWXU or push @bad => "$file is not user RWX"; $mode & S_IRWXG or push @bad => "$file is not group RWX"; $mode & S_IRWXO or push @bad => "$file is not other RWX"; return \@bad; } my $system_tmp = clean_path($ENV{SYSTEM_TMPDIR}); my $problems = check_perms($system_tmp); skip_all join ", " => @$problems if @$problems; my $path = $ENV{TMPDIR}; is(check_perms($path), [], "tempdir has correct permissions"); my $last = $path; my $cnt = 0; while ($system_tmp) { my $next = clean_path(File::Spec->catdir($last, File::Spec->updir())); last if $next eq $system_tmp; # We hit system temp, we can stop last if $next eq $last; # We probably hit root last if $cnt++ > 10; # Something went wrong, no need to loop forever $last = $next; is(check_perms($next), [], "$next has correct permissions"); } done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/exception.t���������������������������������������������������������������0000644�0001750�0001750�00000000340�15012417054�016776� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-DURATION-SHORT my $file = __FILE__; my $line = __LINE__ + 1; sub throw { die("xxx") }; is( dies { throw() }, "xxx at $file line $line.\n", "Got exception as expected" ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/dollardot.t���������������������������������������������������������������0000644�0001750�0001750�00000000103�15012417054�016761� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; is($., undef, "\$. is set to undef"); done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/subtests.t����������������������������������������������������������������0000644�0001750�0001750�00000001133�15012417054�016655� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl # HARNESS-DURATION-MEDIUM use Test2::V0; use Time::HiRes qw/sleep/; use Test2::Tools::AsyncSubtest; ok(1, "pass"); my $astA = async_subtest 'ast A'; $astA->run(sub { ok(1, "ast A 1") }); subtest out => sub { ok(1, "pass"); ok(1, "pass"); my $astB = async_subtest 'ast B'; $astB->run(sub { ok(1, "ast B 1") }); $astA->run(sub { ok(1, "ast A 2") }); $astB->finish; subtest in => sub { for (1 .. 10) { ok(1, "pass $_"); sleep 0.1; } }; ok(1, "pass"); ok(1, "pass"); }; $astA->finish; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/findbin.t�����������������������������������������������������������������0000644�0001750�0001750�00000000112�15012417054�016406� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-DURATION-SHORT use ok 'FindBin'; done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/builder.t�����������������������������������������������������������������0000644�0001750�0001750�00000000110�15012417054�016421� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test::More; # HARNESS-DURATION-SHORT ok(1, "pass"); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/utf8-2.t������������������������������������������������������������������0000644�0001750�0001750�00000002447�15012417054�016037� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use utf8; use strict; use warnings; use Test::More; use Test2::Plugin::UTF8; use Test2::API qw/test2_stack/; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Tools::Basic qw/skip_all/; use File::Spec; use Test2::Util qw/get_tid ipc_separator/; # HARNESS-DURATION-SHORT # HARNESS-NO-IO-EVENTS test2_stack()->top; my ($hub) = test2_stack()->all(); my $fmt = $hub->format; skip_all "This test requires the stream formatter" unless $fmt && $fmt->isa('Test2::Formatter::Stream'); print STDOUT "STDOUT: Mākaha\n"; note "NOTE: Mākaha"; ok(1, "ASSERT: Mākaha"); my $file = File::Spec->catfile($fmt->dir, join(ipc_separator() => 'events', $$, 0) . ".jsonl"); open(my $events_fh, '<:utf8', $file) or die "Could not open events file: $!"; open(my $stdout_fh, '<:utf8', File::Spec->catfile($ENV{TEST2_JOB_DIR}, 'stdout')) or die "Could not open STDOUT for reading: $!"; my @events = map { decode_json($_) } grep m/(NOTE|DIAG|ASSERT): /, <$events_fh>; my ($stdout) = grep m/STDOUT: /, <$stdout_fh>; is($stdout, "STDOUT: Mākaha\n", "Round trip STDOUT encoding/decoding"); is($events[0]->{facet_data}->{info}->[0]->{details}, "NOTE: Mākaha", "Round trip encoding/decoding a note"); is($events[1]->{facet_data}->{assert}->{details}, "ASSERT: Mākaha", "Round trip encoding/decoding an assert"); done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/simple.t������������������������������������������������������������������0000644�0001750�0001750�00000000131�15012417054�016267� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # HARNESS-DURATION-SHORT use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/output.t������������������������������������������������������������������0000644�0001750�0001750�00000000626�15012417054�016347� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-DURATION-SHORT use Test2::Require::AuthorTesting; # All these prints intentionally have no newlines print STDERR "STDERR Before any events"; print STDOUT "STDOUT Before any events"; ok(1, "pass"); print STDERR "STDERR Between events"; print STDOUT "STDOUT Between events"; ok(1, "pass"); print STDERR "STDERR after events"; print STDOUT "STDOUT after events"; done_testing; ����������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/ending.t������������������������������������������������������������������0000644�0001750�0001750�00000000442�15012417054�016247� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# HARNESS-DURATION-SHORT package FooBarBaz; use strict; use warnings; use Test2::V0; open(my $fh, '<', __FILE__) or die "Could not open this file!: $!"; my @end = <$fh>; close($fh); is($end[-1], 'done_testing', "no semicolon or newline is present at the end of this file"); done_testing������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/caller.t������������������������������������������������������������������0000644�0001750�0001750�00000000541�15012417054�016245� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package FooBarBaz; use strict; use warnings; # HARNESS-DURATION-SHORT use Test2::V0; is([caller(0)], [], "No caller at the flat test level"); is(__PACKAGE__, 'FooBarBaz', "inside main package"); like(__FILE__, qr/caller\.t$/, "__FILE__ is correct"); is(__LINE__, 11, "Got the correct line number"); is($@, '', '$@ set to empty string'); done_testing;���������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/vars.t��������������������������������������������������������������������0000644�0001750�0001750�00000000420�15012417054�015752� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(defined($ENV{$_}), "env var $_ is set") for qw{ HARNESS_ACTIVE TEST2_HARNESS_ACTIVE TEST2_ACTIVE TEST_ACTIVE TEST2_RUN_DIR TEST2_JOB_DIR T2_HARNESS_JOB_IS_TRY T2_HARNESS_JOB_NAME T2_HARNESS_JOB_FILE }; done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/utf8.t��������������������������������������������������������������������0000644�0001750�0001750�00000001274�15012417054�015675� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use utf8; use Test2::V0; use Test2::Plugin::UTF8; use Test2::API qw/test2_stack/; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Util qw/get_tid ipc_separator/; # HARNESS-DURATION-SHORT test2_stack()->top; my ($hub) = test2_stack()->all(); my $fmt = $hub->format; skip_all "This test requires the stream formatter" unless $fmt && $fmt->isa('Test2::Formatter::Stream'); ok(1, "І ще трохи"); my $file = File::Spec->catfile($fmt->dir, join(ipc_separator() => 'events', $$, 0) . ".jsonl"); open(my $fh, '<:utf8', $file) or die "Could not open events file: $!"; my @lines = <$fh>; like($lines[-1], qr/\QІ ще трохи\E/, "Wrote utf8, not double encoded"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/t2/data.t��������������������������������������������������������������������0000644�0001750�0001750�00000000233�15012417054�015712� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-DURATION-SHORT is( [<DATA>], ["foo\n", "bar\n", "baz\n"], "Got data section" ); done_testing; __DATA__ foo bar baz ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/META.yml���������������������������������������������������������������������0000644�0001750�0001750�00000003600�15012417054�015541� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������--- abstract: 'A new and improved test harness with better Test2 integration.' author: - 'Chad Granum <exodist@cpan.org>' build_requires: File::Copy: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.032, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Test2-Harness requires: Carp: '0' Config: '0' Cwd: '0' Data::Dumper: '0' Data::UUID: '0' Exporter: '0' Fcntl: '0' File::Find: '0' File::Path: '2.11' File::Spec: '0' File::Temp: '0' Filter::Util::Call: '0' IO::Compress::Bzip2: '0' IO::Compress::Gzip: '0' IO::Handle: '1.27' IO::Uncompress::Bunzip2: '0' IO::Uncompress::Gunzip: '0' IPC::Cmd: '0' Importer: '0.025' JSON::PP: '0' List::Util: '1.44' Long::Jump: '0.000001' POSIX: '0' Scalar::Util: '0' Scope::Guard: '0' Symbol: '0' Sys::Hostname: '0' Term::Table: '0.015' Test2: '1.302170' Test2::API: '1.302170' Test2::Bundle::Extended: '0.000127' Test2::Event: '1.302170' Test2::Event::V2: '1.302170' Test2::Formatter: '1.302170' Test2::Plugin::MemUsage: '0.002003' Test2::Plugin::UUID: '0.002001' Test2::Tools::AsyncSubtest: '0.000127' Test2::Tools::Subtest: '0.000127' Test2::Util: '1.302170' Test2::Util::Term: '0.000127' Test2::V0: '0.000127' Test::Builder: '1.302170' Test::Builder::Formatter: '1.302170' Test::More: '1.302170' Text::ParseWords: '0' Time::HiRes: '0' YAML::Tiny: '0' base: '0' constant: '0' goto::file: '0.005' parent: '0' perl: '5.010000' resources: bugtracker: https://github.com/Test-More/Test2-Harness/issues repository: https://github.com/Test-More/Test2-Harness/ version: '1.000158' x_generated_by_perl: v5.40.1 x_serialization_backend: 'YAML::Tiny version 1.76' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' ��������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/cpanfile���������������������������������������������������������������������0000644�0001750�0001750�00000005163�15012417054�016002� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# This file is generated by Dist::Zilla::Plugin::CPANFile v6.032 # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "Carp" => "0"; requires "Config" => "0"; requires "Cwd" => "0"; requires "Data::Dumper" => "0"; requires "Data::UUID" => "0"; requires "Exporter" => "0"; requires "Fcntl" => "0"; requires "File::Find" => "0"; requires "File::Path" => "2.11"; requires "File::Spec" => "0"; requires "File::Temp" => "0"; requires "Filter::Util::Call" => "0"; requires "IO::Compress::Bzip2" => "0"; requires "IO::Compress::Gzip" => "0"; requires "IO::Handle" => "1.27"; requires "IO::Uncompress::Bunzip2" => "0"; requires "IO::Uncompress::Gunzip" => "0"; requires "IPC::Cmd" => "0"; requires "Importer" => "0.025"; requires "JSON::PP" => "0"; requires "List::Util" => "1.44"; requires "Long::Jump" => "0.000001"; requires "POSIX" => "0"; requires "Scalar::Util" => "0"; requires "Scope::Guard" => "0"; requires "Symbol" => "0"; requires "Sys::Hostname" => "0"; requires "Term::Table" => "0.015"; requires "Test2" => "1.302170"; requires "Test2::API" => "1.302170"; requires "Test2::Bundle::Extended" => "0.000127"; requires "Test2::Event" => "1.302170"; requires "Test2::Event::V2" => "1.302170"; requires "Test2::Formatter" => "1.302170"; requires "Test2::Plugin::MemUsage" => "0.002003"; requires "Test2::Plugin::UUID" => "0.002001"; requires "Test2::Tools::AsyncSubtest" => "0.000127"; requires "Test2::Tools::Subtest" => "0.000127"; requires "Test2::Util" => "1.302170"; requires "Test2::Util::Term" => "0.000127"; requires "Test2::V0" => "0.000127"; requires "Test::Builder" => "1.302170"; requires "Test::Builder::Formatter" => "1.302170"; requires "Test::More" => "1.302170"; requires "Text::ParseWords" => "0"; requires "Time::HiRes" => "0"; requires "YAML::Tiny" => "0"; requires "base" => "0"; requires "constant" => "0"; requires "goto::file" => "0.005"; requires "parent" => "0"; requires "perl" => "5.010000"; suggests "Cpanel::JSON::XS" => "0"; suggests "Email::Stuffer" => "0.016"; suggests "HTTP::Tiny" => "0.070"; suggests "HTTP::Tiny::Multipart" => "0.08"; suggests "IO::Pager" => "1.00"; suggests "JSON::MaybeXS" => "0"; suggests "Term::ANSIColor" => "4.03"; suggests "Test2::Plugin::Cover" => "0.000025"; suggests "Test2::Plugin::DBIProfile" => "0.002002"; suggests "Test2::Plugin::IOEvents" => "0.001001"; suggests "Win32::Console::ANSI" => "0"; on 'test' => sub { requires "File::Copy" => "0"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; }; on 'develop' => sub { requires "Test2::Require::Module" => "0.000127"; requires "Test::Pod" => "1.41"; requires "Test::Spelling" => "0.12"; }; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/dist.ini���������������������������������������������������������������������0000644�0001750�0001750�00000012233�15012417054�015736� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������name = Test2-Harness author = Chad Granum <exodist@cpan.org> license = Perl_5 copyright_holder = Chad Granum [RewriteVersion] ; sets dist version from main module's $VERSION [License] [ManifestSkip] [Manifest] [NextRelease] [GatherFile] filename = .yath.rc [GatherDir] exclude_match = ^xt/downstream ; only run these tests locally exclude_match = ^pt ; only run these tests locally exclude_match = ^tt ; only run these tests locally exclude_match = ^release-scripts exclude_match = ^cover exclude_match = ^nyt exclude_match = ^test-logs exclude_match = ^t/ exclude_match = ^t2/ exclude_match = ^old/ exclude_filename = LICENSE exclude_filename = Makefile.PL exclude_filename = cpanfile exclude_filename = cpanfile.ci exclude_filename = README exclude_filename = README.md exclude_filename = .yath-persist.json [Git::GatherDir / GatherDotFilesT] root = t/ prefix = t/ include_dotfiles = 1 [Git::GatherDir / GatherDotFilesT2] root = t2/ prefix = t2/ include_dotfiles = 1 [Run::AfterBuild] run = release-scripts/generate_command_pod.pl %d run = release-scripts/generate_options_pod.pl %d [ExecDir] dir = scripts [PodSyntaxTests] [TestRelease] [MetaResources] bugtracker.web = https://github.com/Test-More/Test2-Harness/issues repository.url = https://github.com/Test-More/Test2-Harness/ repository.type = git [Prereqs] perl = 5.010000 Test2 = 1.302170 Test2::API = 1.302170 Test2::Event = 1.302170 Test2::Event::V2 = 1.302170 Test2::Formatter = 1.302170 Test2::Util = 1.302170 Test::Builder = 1.302170 Test::Builder::Formatter = 1.302170 Test::More = 1.302170 Test2::Tools::AsyncSubtest = 0.000127 Test2::Tools::Subtest = 0.000127 Test2::Util::Term = 0.000127 Test2::V0 = 0.000127 Test2::Bundle::Extended = 0.000127 Test2::Plugin::MemUsage = 0.002003 Test2::Plugin::UUID = 0.002001 Long::Jump = 0.000001 Term::Table = 0.015 Importer = 0.025 goto::file = 0.005 File::Path = 2.11 List::Util = 1.44 IO::Handle = 1.27 YAML::Tiny = 0 Data::UUID = 0 File::Find = 0 Carp = 0 Config = 0 Cwd = 0 Data::Dumper = 0 Exporter = 0 Fcntl = 0 File::Spec = 0 File::Temp = 0 Filter::Util::Call = 0 IO::Compress::Bzip2 = 0 IO::Compress::Gzip = 0 IO::Uncompress::Bunzip2 = 0 IO::Uncompress::Gunzip = 0 IPC::Cmd = 0 JSON::PP = 0 POSIX = 0 Scalar::Util = 0 Symbol = 0 Time::HiRes = 0 base = 0 constant = 0 parent = 0 Sys::Hostname = 0 Scope::Guard = 0 Text::ParseWords = 0 [Prereqs / TestRequires] File::Copy = 0 [Prereqs / DevelopRequires] Test::Spelling = 0.12 ; for xt/author/pod-spell.t Test2::Require::Module = 0.000127 [Prereqs / RuntimeSuggests] JSON::MaybeXS = 0 Cpanel::JSON::XS = 0 Term::ANSIColor = 4.03 Email::Stuffer = 0.016 HTTP::Tiny = 0.070 IO::Pager = 1.00 Test2::Plugin::IOEvents = 0.001001 HTTP::Tiny::Multipart = 0.08 Test2::Plugin::DBIProfile = 0.002002 Test2::Plugin::Cover = 0.000025 Win32::Console::ANSI = 0 [MakeMaker::Awesome] :version = 0.26 delimiter = | header = |use Config qw/%Config/; header = |die "OS unsupported\nTest2-Harness currently only works on systems that support true forking.\n" header = | unless $Config{d_fork}; header = |if ($ENV{AUTOMATED_TESTING}) { header = | my $is_njh = 0; header = | $is_njh ||= -d '/export/home/njh'; header = | $is_njh ||= -d '/home/njh'; header = | $is_njh ||= lc($ENV{USER} // 'na') eq 'njh'; header = | $is_njh ||= lc($ENV{HOME} // 'na') =~ m{njh$}; header = | $is_njh ||= lc($ENV{PATH} // 'na') =~ m{/njh/}; header = | die "OS unsupported\nNJH smokers are broken, aborting tests.\n" header = | if $is_njh; header = |} [CPANFile] [MetaYAML] [MetaJSON] ; authordep Pod::Markdown [ReadmeFromPod / Markdown] filename = lib/App/Yath.pm type = markdown readme = README.md [ReadmeFromPod / Text] filename = lib/App/Yath.pm type = text readme = README [CopyFilesFromBuild] copy = LICENSE copy = cpanfile copy = README copy = README.md copy = Makefile.PL [Git::Check] allow_dirty = Makefile.PL allow_dirty = README allow_dirty = README.md allow_dirty = cpanfile allow_dirty = LICENSE allow_dirty = Changes [Git::Commit] allow_dirty = Makefile.PL allow_dirty = README allow_dirty = README.md allow_dirty = cpanfile allow_dirty = LICENSE allow_dirty = Changes [Git::Tag] [FakeRelease] [BumpVersionAfterRelease] [Git::Commit / Commit_Changes] munge_makefile_pl = true allow_dirty_match = ^lib allow_dirty_match = ^scripts allow_dirty = Makefile.PL allow_dirty = README allow_dirty = README.md allow_dirty = cpanfile allow_dirty = LICENSE commit_msg = Automated Version Bump ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/.yath.rc���������������������������������������������������������������������0000644�0001750�0001750�00000000147�15012417054�015644� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������-D -D=rel(t2/lib) ;-pSelfTest --project Test2-Harness [test] -Irel(t2/lib) --default-search glob(t/*) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/MANIFEST���������������������������������������������������������������������0000644�0001750�0001750�00000025644�15012417054�015435� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.032. .yath.rc Changes LICENSE MANIFEST META.json META.yml Makefile.PL README README.md appveyor.yml cpanfile dist.ini lib/App/Yath.pm lib/App/Yath/Command.pm lib/App/Yath/Command/abort.pm lib/App/Yath/Command/auditor.pm lib/App/Yath/Command/collector.pm lib/App/Yath/Command/do.pm lib/App/Yath/Command/failed.pm lib/App/Yath/Command/help.pm lib/App/Yath/Command/init.pm lib/App/Yath/Command/kill.pm lib/App/Yath/Command/projects.pm lib/App/Yath/Command/ps.pm lib/App/Yath/Command/reload.pm lib/App/Yath/Command/replay.pm lib/App/Yath/Command/resources.pm lib/App/Yath/Command/run.pm lib/App/Yath/Command/runner.pm lib/App/Yath/Command/spawn.pm lib/App/Yath/Command/speedtag.pm lib/App/Yath/Command/start.pm lib/App/Yath/Command/status.pm lib/App/Yath/Command/stop.pm lib/App/Yath/Command/test.pm lib/App/Yath/Command/times.pm lib/App/Yath/Command/watch.pm lib/App/Yath/Command/which.pm lib/App/Yath/Converting.pm lib/App/Yath/Option.pm lib/App/Yath/Options.pm lib/App/Yath/Options/Collector.pm lib/App/Yath/Options/Debug.pm lib/App/Yath/Options/Display.pm lib/App/Yath/Options/Finder.pm lib/App/Yath/Options/Logging.pm lib/App/Yath/Options/Persist.pm lib/App/Yath/Options/PreCommand.pm lib/App/Yath/Options/Run.pm lib/App/Yath/Options/Runner.pm lib/App/Yath/Options/Workspace.pm lib/App/Yath/Plugin.pm lib/App/Yath/Plugin/Cover.pm lib/App/Yath/Plugin/Git.pm lib/App/Yath/Plugin/Notify.pm lib/App/Yath/Plugin/SysInfo.pm lib/App/Yath/Plugin/YathUI.pm lib/App/Yath/Tester.pm lib/App/Yath/Util.pm lib/Test2/Formatter/QVF.pm lib/Test2/Formatter/Stream.pm lib/Test2/Formatter/Test2.pm lib/Test2/Formatter/Test2/Composer.pm lib/Test2/Harness.pm lib/Test2/Harness/Auditor.pm lib/Test2/Harness/Auditor/TimeTracker.pm lib/Test2/Harness/Auditor/Watcher.pm lib/Test2/Harness/Collector.pm lib/Test2/Harness/Collector/JobDir.pm lib/Test2/Harness/Collector/TapParser.pm lib/Test2/Harness/Event.pm lib/Test2/Harness/Finder.pm lib/Test2/Harness/IPC.pm lib/Test2/Harness/IPC/Process.pm lib/Test2/Harness/Log.pm lib/Test2/Harness/Log/CoverageAggregator.pm lib/Test2/Harness/Log/CoverageAggregator/ByRun.pm lib/Test2/Harness/Log/CoverageAggregator/ByTest.pm lib/Test2/Harness/Plugin.pm lib/Test2/Harness/Renderer.pm lib/Test2/Harness/Renderer/Formatter.pm lib/Test2/Harness/Run.pm lib/Test2/Harness/Runner.pm lib/Test2/Harness/Runner/Constants.pm lib/Test2/Harness/Runner/DepTracer.pm lib/Test2/Harness/Runner/Job.pm lib/Test2/Harness/Runner/Preload.pm lib/Test2/Harness/Runner/Preload/Stage.pm lib/Test2/Harness/Runner/Preloader.pm lib/Test2/Harness/Runner/Preloader/Stage.pm lib/Test2/Harness/Runner/Reloader.pm lib/Test2/Harness/Runner/Resource.pm lib/Test2/Harness/Runner/Resource/JobCount.pm lib/Test2/Harness/Runner/Resource/SharedJobSlots.pm lib/Test2/Harness/Runner/Resource/SharedJobSlots/Config.pm lib/Test2/Harness/Runner/Resource/SharedJobSlots/State.pm lib/Test2/Harness/Runner/Run.pm lib/Test2/Harness/Runner/Spawn.pm lib/Test2/Harness/Runner/State.pm lib/Test2/Harness/Settings.pm lib/Test2/Harness/Settings/Prefix.pm lib/Test2/Harness/TestFile.pm lib/Test2/Harness/Util.pm lib/Test2/Harness/Util/File.pm lib/Test2/Harness/Util/File/JSON.pm lib/Test2/Harness/Util/File/JSONL.pm lib/Test2/Harness/Util/File/Stream.pm lib/Test2/Harness/Util/File/Value.pm lib/Test2/Harness/Util/HashBase.pm lib/Test2/Harness/Util/IPC.pm lib/Test2/Harness/Util/JSON.pm lib/Test2/Harness/Util/Queue.pm lib/Test2/Harness/Util/Term.pm lib/Test2/Harness/Util/UUID.pm lib/Test2/Tools/HarnessTester.pm scripts/yath t/0-load_all.t t/1-pod_name.t t/HashBase.t t/integration/concurrency.t t/integration/concurrency/a.tx t/integration/concurrency/b.tx t/integration/concurrency/c.tx t/integration/concurrency/d.tx t/integration/concurrency/e.tx t/integration/coverage.t t/integration/coverage/a.tx t/integration/coverage/b.tx t/integration/coverage/c.tx t/integration/coverage/lib/Ax.pm t/integration/coverage/lib/Bx.pm t/integration/coverage/lib/Cx.pm t/integration/coverage/lib/Manager.pm t/integration/coverage/lib/Plugin.pm t/integration/coverage/once.tx t/integration/coverage/open.tx t/integration/coverage/x.tx t/integration/coverage2.t t/integration/coverage3.t t/integration/coverage4.t t/integration/encoding.t t/integration/encoding/no-plugin.tx t/integration/encoding/plugin.tx t/integration/failed.t t/integration/failed/fail.tx t/integration/failed/pass.tx t/integration/failure_cases.t t/integration/failure_cases/badplan.tx t/integration/failure_cases/buffered_subtest_abrupt_end.tx t/integration/failure_cases/buffered_subtest_abrupt_end_nested.tx t/integration/failure_cases/dupnums.tx t/integration/failure_cases/exit.tx t/integration/failure_cases/missingnums.tx t/integration/failure_cases/nested_subtest.tx t/integration/failure_cases/nested_subtest_exception.tx t/integration/failure_cases/noplan.tx t/integration/failure_cases/notok.tx t/integration/failure_cases/parse_error.tx t/integration/failure_cases/post_exit_timeout.tx t/integration/failure_cases/subtest.tx t/integration/failure_cases/timeout.tx t/integration/help.t t/integration/includes.t t/integration/includes/.yath.rc t/integration/includes/default-i.tx t/integration/includes/default.tx t/integration/includes/dot-last.tx t/integration/includes/not-perl.pl t/integration/includes/not-perl.sh t/integration/includes/order-ibili.tx t/integration/includes/order-ilibi.tx t/integration/init.t t/integration/log_dir.t t/integration/log_dir/foo.tx t/integration/persist.t t/integration/persist/fail.txx t/integration/persist/pass.tx t/integration/plugin.t t/integration/plugin/a.tx t/integration/plugin/b.tx t/integration/plugin/c.tx t/integration/plugin/d.tx t/integration/plugin/lib/App/Yath/Plugin/TestPlugin.pm t/integration/plugin/test.tx t/integration/preload.t t/integration/preload/aaa.tx t/integration/preload/bbb.tx t/integration/preload/ccc.tx t/integration/preload/fast.tx t/integration/preload/lib/AAA.pm t/integration/preload/lib/BBB.pm t/integration/preload/lib/Broken.pm t/integration/preload/lib/CCC.pm t/integration/preload/lib/FAST.pm t/integration/preload/lib/TestBadPreload.pm t/integration/preload/lib/TestPreload.pm t/integration/preload/lib/TestSimplePreload.pm t/integration/preload/no_preload.tx t/integration/preload/preload_test.tx t/integration/preload/retry.tx t/integration/preload/simple_test.tx t/integration/preload/slow.tx t/integration/projects.t t/integration/projects/bar/lib/Bar.pm t/integration/projects/bar/lib/Baz.pm t/integration/projects/bar/lib/Foo.pm t/integration/projects/bar/t/pass.tx t/integration/projects/baz/lib/Bar.pm t/integration/projects/baz/lib/Baz.pm t/integration/projects/baz/lib/Foo.pm t/integration/projects/baz/t/fail.txx t/integration/projects/baz/t/pass.tx t/integration/projects/foo/lib/Bar.pm t/integration/projects/foo/lib/Baz.pm t/integration/projects/foo/lib/Foo.pm t/integration/projects/foo/t/pass.tx t/integration/reload.t t/integration/reload/lib/Preload.pm t/integration/reload/lib/Preload/A.pm t/integration/reload/lib/Preload/B.pm t/integration/reload/lib/Preload/Churn.pm t/integration/reload/lib/Preload/ExceptionA.pm t/integration/reload/lib/Preload/ExceptionB.pm t/integration/reload/lib/Preload/ExporterA.pm t/integration/reload/lib/Preload/ExporterB.pm t/integration/reload/lib/Preload/IncChange.pm t/integration/reload/lib/Preload/WarningA.pm t/integration/reload/lib/Preload/WarningB.pm t/integration/reload/lib/Preload/nonperl1 t/integration/reload/lib/Preload/nonperl2 t/integration/reload_syntax_error.t t/integration/reload_syntax_error.tx t/integration/replay.t t/integration/replay/fail.tx t/integration/replay/pass.tx t/integration/resource.t t/integration/resource/Resource.pm t/integration/resource/a.tx t/integration/resource/b.tx t/integration/resource/c.tx t/integration/resource/d.tx t/integration/retry-symlinks/retry.tx t/integration/retry-symlinks/symlink.tl t/integration/retry-timeout/retry.tx t/integration/retry.t t/integration/retry/retry.tx t/integration/signals.t t/integration/signals/abrt_or_iot.t t/integration/slots_per_job.t t/integration/slots_per_job2.t t/integration/slots_per_job3.t t/integration/smoke.t t/integration/smoke/a.tx t/integration/smoke/b.tx t/integration/smoke/c.tx t/integration/smoke/d.tx t/integration/smoke/e.tx t/integration/smoke/f.tx t/integration/smoke/g.tx t/integration/smoke/h.tx t/integration/smoke/lib/SmokePlugin.pm t/integration/speedtag.t t/integration/speedtag/pass.tx t/integration/speedtag/pass2.tx t/integration/stamps.t t/integration/stamps/fail.tx t/integration/stamps/lib/App/Yath/Plugin/TestPlugin.pm t/integration/stamps/pass.tx t/integration/tapsubtest.t t/integration/tapsubtest/test.tx t/integration/test-broken-symlinks/keepme t/integration/test-broken-symlinks/pass.tx t/integration/test-durations.json t/integration/test-durations/fast-01.tx t/integration/test-durations/fast-02.tx t/integration/test-durations/fast-03.tx t/integration/test-durations/fast-04.tx t/integration/test-durations/slow-01.tx t/integration/test-durations/slow-02.tx t/integration/test-inc/check-INC.tx t/integration/test-symlinks/_base.xt t/integration/test-symlinks/symlink_to_base.xt t/integration/test-w.t t/integration/test-w/a.tx t/integration/test-w/b.tx t/integration/test.t t/integration/test/fail.txx t/integration/test/pass.tx t/integration/test/pass.txxx t/integration/times.t t/integration/times/pass.tx t/integration/times/pass2.tx t/integration/verbose_env.t t/integration/verbose_env/not_verbose.tx t/integration/verbose_env/verbose1.tx t/integration/verbose_env/verbose2.tx t/lib/App/Yath/Command/broken.pm t/lib/App/Yath/Command/fake.pm t/lib/App/Yath/Plugin/Fail.pm t/lib/App/Yath/Plugin/Options.pm t/unit/App/Yath.t t/unit/App/Yath/Command/init.t t/unit/App/Yath/Option.t t/unit/App/Yath/Options.t t/unit/App/Yath/Plugin.t t/unit/App/Yath/Plugin/Git.script t/unit/App/Yath/Plugin/Git.t t/unit/App/Yath/Plugin/SysInfo.t t/unit/App/Yath/Util.t t/unit/Test2/Harness/Runner/DepTracer.t t/unit/Test2/Harness/Runner/Resource/SharedJobSlots/.sharedjobslots.yml t/unit/Test2/Harness/Runner/Resource/SharedJobSlots/Config.t t/unit/Test2/Harness/Runner/Resource/SharedJobSlots/State.t t/unit/Test2/Harness/Settings.t t/unit/Test2/Harness/Settings/Prefix.t t/unit/Test2/Harness/TestFile.t t/unit/Test2/Harness/Util.t t/unit/Test2/Harness/Util/File.t t/unit/Test2/Harness/Util/File/JSON.t t/unit/Test2/Harness/Util/File/JSONL.t t/unit/Test2/Harness/Util/File/Stream.t t/unit/Test2/Harness/Util/File/Value.t t/unit/Test2/Harness/Util/JSON.t t/unit/Test2/Harness/Util/Term.t t/unit/Test2/Tools/HarnessTester.t t/yath_script.t t/yath_script/.yath.rc t/yath_script/nested/.yath.user.rc t/yath_script/nested/scripts/yath t2/builder.t t2/caller.t t2/data.t t2/dollardot.t t2/ending.t t2/exception.t t2/findbin.t t2/ipc_reexec.t t2/lib/App/Yath/Plugin/SelfTest.pm t2/magic_vars.t t2/no_stdout_eol.t t2/non_perl/test.c t2/non_perl/test.sh t2/output.t t2/relative_paths.t t2/relative_paths_no_fork.t t2/require_file.pm t2/require_file.t t2/simple.t t2/subtests.t t2/subtests_buffered.t t2/subtests_streamed.t t2/tmp_perms.t t2/utf8-2.t t2/utf8.t t2/vars.t test.pl xt/author/pod-spell.t xt/author/pod-syntax.t ��������������������������������������������������������������������������������������������Test2-Harness-1.000158/test.pl����������������������������������������������������������������������0000644�0001750�0001750�00000001373�15012417054�015611� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/env perl # HARNESS-NO-RUN use strict; use warnings; use lib 'lib'; use App::Yath::Util qw/find_yath/; print "1..2\n"; $ENV{'YATH_SELF_TEST'} = 1; system($^X, find_yath(), '-D', 'test', '--qvf', '-r1', '--default-search' => './t', '--default-search' => './t2', @ARGV); my $exit1 = $?; $ENV{T2_NO_FORK} = 1; system($^X, find_yath(), '-D', 'test', '--qvf', '-r1', '--default-search' => './t', '--default-search' => './t2', @ARGV); my $exit2 = $?; print "not " if $exit1; print "ok 1 - Passed tests when run by yath (allow fork)\n"; print STDERR "yath exited with $exit1" if $exit1; print "not " if $exit2; print "ok 2 - Passed tests when run by yath (no fork)\n"; print STDERR "yath exited with $exit2" if $exit2; exit($exit1 || $exit2 ? 255 : 0); ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/Changes����������������������������������������������������������������������0000644�0001750�0001750�00000125344�15012417054�015575� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������1.000158 2025-05-18 10:51:39-07:00 America/Los_Angeles - Fix #280 - warnings in test 1.000157 2025-05-04 04:13:46-07:00 America/Los_Angeles - Version bump to fix a botched trial release 1.000156 2025-01-22 09:54:36-08:00 America/Los_Angeles - Poll for filesystem changes less often 1.000155 2023-10-03 08:53:01-07:00 America/Los_Angeles - Fix sleep that is often interrupted 1.000154 2023-10-02 08:40:50-07:00 America/Los_Angeles - Make it possible to disable shared slots on specific hosts 1.000153 2023-06-14 07:08:47-07:00 America/Los_Angeles - Fix #266 - Fix several declare-lexical+conditional statements 1.000152 2023-04-29 05:30:12-07:00 America/Los_Angeles - Do not require non-perl script tests to be executable - Fix issue where Carp::Always being loaded by PERL5OPT or similar does not crash 1.000151 2023-03-08 07:11:31-08:00 America/Los_Angeles - Fix issue where rarely some UUIDs could be duplicated with IPC 1.000150 2023-03-01 13:40:42-08:00 America/Los_Angeles - Add ability to override 'add' value in rerun grabbing 1.000149 2023-02-28 09:13:50-08:00 America/Los_Angeles - Add more 'rerun' capabilities - Fix diagnostcis replacing '0' with an empty string 1.000148 2023-02-22 17:17:49-08:00 America/Los_Angeles - Fix output corruption in interactive mode 1.000147 2023-02-21 08:16:35-08:00 America/Los_Angeles - Show all output early in interactive mode 1.000146 2023-02-20 18:21:51-08:00 America/Los_Angeles - Fix infinite hang in bad preload (#240) - Remove some debugging - Fix #261 ($. being set incorrectly) 1.000145 2023-02-15 17:31:10-08:00 America/Los_Angeles - Add ability to inject lines in resource output 1.000144 2023-02-15 13:29:48-08:00 America/Los_Angeles - Skip empty tables in resource view 1.000143 2023-02-15 08:33:57-08:00 America/Los_Angeles - Add 'autofill' to simplify 'd' and 'D' option types - Better resource management 1.000142 2023-01-25 14:38:31-08:00 America/Los_Angeles - Add more capabilities around argument processing 1.000141 2022-12-15 14:15:39-08:00 America/Los_Angeles - Fix typo in rare conditional 1.000140 2022-12-13 18:11:36-08:00 America/Los_Angeles - Fix permissions issue with state files 1.000139 2022-12-13 11:49:03-08:00 America/Los_Angeles - Add 'COMMON' config options for shared slots - Add options for default j and x values in shared slots 1.000138 2022-12-06 06:52:55-08:00 America/Los_Angeles - Fix resources output for shared slots - Make slots a range, not a single value 1.000137 2022-12-05 13:15:45-08:00 America/Los_Angeles - Rework shared slots logic 1.000136 2022-11-29 13:56:37-08:00 America/Los_Angeles - Add ability to sort resource plugins to get them in order. 1.000135 2022-11-29 10:44:53-08:00 America/Los_Angeles - Add ability to specify a umask for shared slots files 1.000134 2022-11-29 10:03:09-08:00 America/Los_Angeles - Add ability to assign multiple slots to jobs - Add shared job slots 1.000133 2022-09-07 13:44:03-07:00 America/Los_Angeles - Order tests with conflicts earlier than others 1.000132 2022-09-07 09:42:06-07:00 America/Los_Angeles - Further improve resource command and file 1.000131 2022-09-06 15:53:55-07:00 America/Los_Angeles - Use relative file paths for job slot display 1.000130 2022-09-06 14:39:43-07:00 America/Los_Angeles - Better resource display - Fix #255 (.test_info.json being left behind) - Fix issue where not all resources will be loaded by resource command 1.000129 2022-09-06 11:20:38-07:00 America/Los_Angeles - Fix issue with job slots sometimes being doubled when tests are skipped 1.000128 2022-09-02 13:01:09-07:00 America/Los_Angeles - Fix issue where yath might exit before all output is rendered - Add scheduler process - Fix --color flag (Thanks James Raspass, #246) - Fix spelling mistakes (Thanks bernhard, #249) 1.000127 2022-08-31 08:32:44-07:00 America/Los_Angeles - Remove unnecessary Carp::Always 1.000126 2022-08-30 11:09:19-07:00 America/Los_Angeles - Add 'yath resources' command to view resource usage 1.000125 2022-07-08 15:50:11-07:00 America/Los_Angeles - Change -jN to use a resource class instead of hard-coding it into State.pm - Fix bug in how a POSIX function is called 1.000124 2022-04-08 12:26:14-07:00 America/Los_Angeles - Fix bug where see `yath status` was being shown for non-persistent runs - Make 'busy' message shorter so it is less likely to be truncated 1.000123 2022-04-06 13:34:10-07:00 America/Los_Angeles - Fix bug where spawns would not run if queued before stages were ready 1.000122 2022-04-06 11:04:43-07:00 America/Los_Angeles - Fix another id vs uuid typo 1.000121 2022-04-06 10:46:35-07:00 America/Los_Angeles - Fix bug introduced by my last fix... oops 1.000120 2022-04-06 10:17:48-07:00 America/Los_Angeles - Fix bug where a stage reload would re-run all previously requested spawns 1.000119 2022-04-05 10:58:59-07:00 America/Los_Angeles - Allow per-test args to be specified at the command line 1.000118 2022-04-05 09:39:40-07:00 America/Los_Angeles - Do not show broken reload files multiple times 1.000117 2022-04-04 16:09:58-07:00 America/Los_Angeles - Check for reload errors before allowing a `yath run` to work 1.000116 2022-04-01 15:29:40-07:00 America/Los_Angeles - Better handling of version mismatches in the persistent runner - Better info when a `run` command is waiting on a busy runner 1.000115 2022-03-31 10:28:14-07:00 America/Los_Angeles - Fix reload bug when using restricted reload - Fix bug where inotify would only report changes once 1.000114 2022-03-24 09:27:03-07:00 America/Los_Angeles - Fix bug when inotify is not installed - Make yath better at detecting when 2 files are the same 1.000113 2022-03-23 09:36:57-07:00 America/Los_Angeles - Refactor preloader into preloader and reloader - Honor churn blocks during relead events even if --reload is disabled 1.000112 2022-03-15 14:21:29-07:00 America/Los_Angeles - Add --rerun and --rerun-failed options to test/run command - Add lastlog.jsonl.* symlink creation to auto-link to the last log produced 1.000111 2022-03-09 15:07:10-08:00 America/Los_Angeles - Better handling and checking of persistence files 1.000110 2022-02-24 11:50:52-08:00 America/Los_Angeles - Add 'tick()' method to resource classes 1.000109 2022-02-22 12:07:11-08:00 America/Los_Angeles - Do not initialize resources in `yath run` - Add command to settings->harness - Add from_runner to settings included from a persistent runner - Fix temp dir issue in macos 1.000108 2022-02-11 15:23:10-08:00 America/Los_Angeles - Add ability for resource managers to report resources as unavailable ot skip tests - Add setup method for resource managers 1.000107 2022-02-10 08:49:19-08:00 America/Los_Angeles - Clean up FIFO in interactive mode with a persistent runner 1.000106 2022-02-08 10:10:38-08:00 America/Los_Angeles - Fix uninitialized warning 1.000105 2022-02-08 09:52:32-08:00 America/Los_Angeles - Make changes_diff work with or without prefixes in the filenames 1.000104 2022-02-04 11:00:29-08:00 America/Los_Angeles - Add settings ot paremeter list for coverage managers 1.000103 2022-02-04 10:20:32-08:00 America/Los_Angeles - Add options to for whitespace and non-subs in change data --changes-include-whitespace - Include whitespace lines for change data --changes-exclude-nonsub - Do not include non-sub changes in perl files --changes-exclude-opens - Do not include tests that only open() changed files --changes-exclude-loads - Do not include tests that only load changed files without running subs 1.000102 2022-02-03 15:28:54-08:00 America/Los_Angeles - Remove warning that can trigger in valid (not warn-worthy) cases. 1.000101 2022-02-02 13:26:35-08:00 America/Los_Angeles - Fix 'replay' output of subtests 1.000100 2022-02-01 09:49:52-08:00 America/Los_Angeles - Mark reload_syntax_error.t as AUTHOR_TESTING only (#243) - Add threshold for duration data fetching, this saves time when duration data is large 1.000099 2022-01-27 10:20:38-08:00 America/Los_Angeles - Add options to exclude some chnaged files when running coverage tests 1.000098 2022-01-27 09:36:24-08:00 America/Los_Angeles - Fix bugs in 'failed' command after adding subtests 1.000097 2022-01-27 08:31:46-08:00 America/Los_Angeles - Show subtest failures in 'failed' command 1.000096 2022-01-26 14:42:43-08:00 America/Los_Angeles - Show failed subtests in final summary - Fix bug where env vars get removed when we preload Test2::API too early (#241) - Fix bug where replay with test filename has uninitialized warnings (#242) 1.000095 2022-01-07 14:35:25-08:00 America/Los_Angeles - Fix bug where syntax errors prevented reloading of effected files 1.000094 2022-01-05 13:51:40-08:00 America/Los_Angeles - Fix logic so that tests for changed files are only added when requested - Pass all changes to the coverage managers 1.000093 2021-12-16 15:19:47-08:00 America/Los_Angeles - Split out 'get_coverage_tests' logic for reuse 1.000092 2021-12-16 10:39:37-08:00 America/Los_Angeles - Add plugin hook for post-processing of coverage data. 1.000091 2021-12-15 12:09:09-08:00 America/Los_Angeles - Add more reload capabilities (non-perl reloading, callbacks) 1.000090 2021-12-14 12:43:11-08:00 America/Los_Angeles - Fix bug in status command when only 1 run is present 1.000089 2021-12-14 12:12:05-08:00 America/Los_Angeles - Add several commands for managing persisten runners - yath kill - Kill the runner and all tests (stop NOW) - yath ps - Show running yath process list - yath status - Show processes and health status - yath abort - Cancel any running or queued test, but do not kill runner - Control+C in `yath run` does a better job of cleaning up 1.000088 2021-12-13 11:29:24-08:00 America/Los_Angeles - Skip tests that do not exists when running coverage tests 1.000087 2021-12-09 13:51:59-08:00 America/Los_Angeles - Add --procname-prefix option to add custom strings to procnames 1.000086 2021-12-07 13:40:40-08:00 America/Los_Angeles - Add 'HARNESS-CHURN-XXX' directive support 1.000085 2021-12-06 16:28:51-08:00 America/Los_Angeles - Make 'do' actually work 1.000084 2021-12-06 15:59:23-08:00 America/Los_Angeles - Add 'do' command that has the magic of picking run or test as needed 1.000083 2021-12-03 10:18:27-08:00 America/Los_Angeles - Add options for controlling runner output, specially for `yath run` 1.000082 2021-11-18 09:04:17-08:00 America/Los_Angeles - Make collector options configurable - Add collector option for max poll events - Add collector option for max open jobs - Turn warnings about too many open files into proper events 1.000081 2021-11-15 13:27:48-08:00 America/Los_Angeles - Retry opening files later when "too many files open" errors occur 1.000080 2021-11-04 11:13:07-07:00 America/Los_Angeles - Add sort_files_2 for plugins to add settings and future-proof it 1.000079 2021-10-29 10:42:39-07:00 America/Los_Angeles - smarter reloader, bit via callbacks, not assumptions 1.000078 2021-10-28 15:38:10-07:00 America/Los_Angeles - Disable the feature from the last commit, it needs rethinking thanks to things like Moose. 1.000077 2021-10-28 15:14:09-07:00 America/Los_Angeles - Make reloader smarter, do not delete subs from other files when reloading a file 1.000076 2021-10-22 10:29:22-07:00 America/Los_Angeles - Add relative filename to the queued task 1.000075 2021-10-21 14:05:27-07:00 America/Los_Angeles - Fix missing Changes entry for last release 1.000074 2021-10-20 09:58:05-07:00 America/Los_Angeles - Better coverage aggregation and plugin capabilities 1.000073 2021-09-21 10:25:42-07:00 America/Los_Angeles - Load coverage module EARLY in the runner spawn process - Add ability to for plugins to inject CLI options for the runner 1.000072 2021-09-13 09:29:54-07:00 America/Los_Angeles - Wrap fifo creation in a loop for interrupted system calls 1.000071 2021-09-03 08:26:04-07:00 America/Los_Angeles - Allow custom subclasses with cover plugin 1.000070 2021-09-01 13:36:50-07:00 America/Los_Angeles - Improve reload inotify logic 1.000069 2021-08-31 14:07:54-07:00 America/Los_Angeles - Add interactive mode! 1.000068 2021-08-30 09:52:12-07:00 America/Los_Angeles - Expand --cover-dir options with glob() 1.000067 2021-08-27 11:32:10-07:00 America/Los_Angeles - Add option to only reload repo directories 1.000066 2021-08-12 13:48:06-07:00 America/Los_Angeles - Fix 'Cover' plugin to record untested perl files 1.000065 2021-08-04 15:11:59-07:00 America/Los_Angeles - Fix 'Cover' plugin bugs and edge cases 1.000064 2021-08-02 15:23:04-07:00 America/Los_Angeles - Add more capabilities for plugins - Add the 'Cover' plugin to handle coverage in a better way 1.000063 2021-07-14 09:44:17-07:00 America/Los_Angeles - Add diags/notes to notification problem-capture 1.000062 2021-07-07 15:34:34-07:00 America/Los_Angeles - Add info on where/why 'claim_file' was called 1.000061 2021-07-07 12:53:11-07:00 America/Los_Angeles - Add even more support for notification plugins 1.000060 2021-07-06 09:51:45-07:00 America/Los_Angeles - Add support for html email 1.000059 2021-07-01 13:56:29-07:00 America/Los_Angeles - Add support for custom email/slack text 1.000058 2021-06-15 15:38:16-07:00 America/Los_Angeles - Add support for new yathui direct db coverage/duration plugin - Add option to disable bail-out abortion 1.000057 2021-06-04 15:59:24-07:00 America/Los_Angeles - Add ability to provide a diff for changed files - Add ability to filter files with changes 1.000056 2021-05-24 14:26:45-07:00 America/Los_Angeles - Fix warnings from preloader 1.000055 2021-05-18 13:05:20-07:00 America/Los_Angeles - Run 'conficting' tests sooner 1.000054 2021-05-04 08:58:25-07:00 America/Los_Angeles - Add option to dump depmaps 1.000053 2021-04-30 11:22:30-07:00 America/Los_Angeles - Be smarter about what can or cannot be reloaded in 'reload' mode 1.000052 2021-04-30 10:37:56-07:00 America/Los_Angeles - Add --reload option to 'start' command to reload moduels in-place when possible - Make Test2::Plugin::Cover optional again 1.000051 2021-04-29 07:40:33-07:00 America/Los_Angeles - Fix an edge-case warning from git plugin 1.000050 2021-04-27 09:22:25-07:00 America/Los_Angeles - Allow a default coverage manager to be provided - Move Test2::Require::Module to dev requirements - Update some modules from 'base' to 'parent' 1.000049 2021-04-26 08:08:05-07:00 America/Los_Angeles - Fully require Test2::Plugin::Cover at a sufficient version 1.000048 2021-04-23 11:54:37-07:00 America/Los_Angeles - Require updated Test2::Plugin::Cover - Better coverage handling, sync with newer Test2::Plguin::Cover 1.000047 2021-04-20 11:42:49-07:00 America/Los_Angeles - Remove some coverage data that was nto intended to be present (false data) 1.000046 2021-04-20 09:25:24-07:00 America/Los_Angeles - Remove debugging print statement 1.000045 2021-04-20 09:14:01-07:00 America/Los_Angeles - Change how coverage and changed-files data works 1.000044 2021-03-11 20:08:54-08:00 America/Los_Angeles - Add plugin support for providing coverage/duration data - Fix running t/integration tests with ./ in path (#215) - Add a fixme/todo test for #216 (Tap subtest parsing) 1.000043 2021-03-05 07:47:04-08:00 America/Los_Angeles - Minor documentation correction - Add 'signal()' method to Renderer base class 1.000042 2020-11-17 22:44:35-08:00 America/Los_Angeles - Fix pipe size setting to actually use the value we want - Fix pipe size setting code for older perls 1.000041 2020-11-17 22:28:55-08:00 America/Los_Angeles - When possible use a larger pipe buffer 1.000040 2020-11-17 21:59:41-08:00 America/Los_Angeles - Fix bug in collector that made it marginally less efficient - Fix bug that prevented no-max from working in JobDir poll - Fix bug that prevented the active status display from updating 1.000039 2020-11-17 19:54:08-08:00 America/Los_Angeles - yath watch shows aux output - Minor no-op code improvement in Runner.pm 1.000038 2020-11-02 20:49:12-08:00 America/Los_Angeles - Add shellcall and aux output capture for plugins 1.000037 2020-11-02 14:31:10-08:00 America/Los_Angeles - Fix conflict between process management and resource management 1.000036 2020-11-01 20:34:19-08:00 America/Los_Angeles - Add initializing status line 1.000035 2020-10-29 15:00:33-07:00 America/Los_Angeles - Add glob() and relgob() .yath.rc pseudo-functions - Document rel() .yath.rc pseudo-function 1.000034 2020-10-29 07:51:19-07:00 America/Los_Angeles - Fix warning when output is not a terminal 1.000033 2020-10-28 16:37:19-07:00 America/Los_Angeles - Better status line while tests are running - Do not use --START-- and --END-- on long single-lines 1.000032 2020-10-23 11:59:34-07:00 America/Los_Angeles - Make it possible to run an alternate file to the one specified 1.000031 2020-10-22 11:27:59-07:00 America/Los_Angeles - Fix incorrect return from $spawn->args 1.000030 2020-10-21 19:34:45-07:00 America/Los_Angeles - Add environment variable management to spawn command - Move spawn logic to overridable methods 1.000029 2020-10-15 13:57:36-07:00 America/Los_Angeles - Add 'spawn' command - Fix plan in test.pl 1.000028 2020-09-25 08:43:43-07:00 America/Los_Angeles - Fix issue where args after :: were ignored (#195) 1.000027 2020-09-21 11:46:43-07:00 America/Los_Angeles - Move dbi_profile and cover_Files to run 1.000026 2020-09-08 13:37:50-07:00 America/Los_Angeles - Make nytprof work in persistent mode 1.000025 2020-09-08 11:29:07-07:00 America/Los_Angeles - Fix edge case where STDIN was opened for writing - Add basic support for nytprof 1.000024 2020-08-24 09:06:43-07:00 America/Los_Angeles - Add Test2::Harness::Runner::Resource for resource management 1.000023 2020-08-14 21:18:29-07:00 America/Los_Angeles - No changes since trial 1.000022 2020-08-13 15:18:07-07:00 America/Los_Angeles (TRIAL RELEASE) - Make failure to chmod things non-fatal to fix bsd testing - Fix spelling issues - Make chmod stuff more correct 1.000021 2020-08-04 21:03:28-07:00 America/Los_Angeles (TRIAL RELEASE) - Add changed_files plugin hook - Make git plugin support changed_files hook - Add Test2::Harness::Log docs - Add 'cover-files' option using Test2::Plugin::Cover - Add coverage aggregator tool - Add ability to run tests that cover changed files - Add dbi-profiling option - Fix permissions on temp dirs (may still have some issues) 1.000020 2020-07-08 22:25:23-07:00 America/Los_Angeles - reduce version of Data::UUID required - Allow filenames in replay - Add 'cover_files' shortcut for Test2::Plugin::Cover 1.000019 2020-05-30 11:07:09-07:00 America/Los_Angeles - Typo Fix in error message - Do not die on 0 failures 1.000018 2020-04-13 13:35:34-07:00 America/Los_Angeles - Stop leaving leftover files in /tmp 1.000017 2020-04-07 15:47:42-07:00 America/Los_Angeles - Fix log_dir test on macos 1.000016 2020-04-07 15:14:00-07:00 America/Los_Angeles - Fix #! in yath script - Fix 'DEFAULT' and 'IGNORE' signal inheritence - Fix log-dir specificiation (#174) 1.000015 2020-03-23 11:49:38-07:00 America/Los_Angeles - YathUI plugin improvements (show url, show errors) - Add more compression options to open_file 1.000014 2020-03-21 18:20:37-07:00 America/Los_Angeles - Add YathUI plugin - Fix maybe_durations option 1.000013 2020-03-18 13:16:20-07:00 America/Los_Angeles - Minor doc change 1.000012 2020-03-18 13:09:14-07:00 America/Los_Angeles - Fix #172 qvf+verbose - Fix #169 log path in 'run' command - Fix #168 - :: mistaken for command name - Fix #171 summary should only be shown when applicable - Fix #171 Add --brief option to 'failed' command 1.000011 2020-03-09 09:12:25-07:00 America/Los_Angeles - Fix notifications so that all failed tests are shown 1.000010 2020-03-08 15:15:24-07:00 America/Los_Angeles - Fix missing Launch in verbose mode - Restore HARNESS_IS_VERBOSE env variable - Fix #163 where 1 concurrent job would get stuck reducing concurrency 1.000009 2020-03-06 14:05:23-08:00 America/Los_Angeles - Add HARNESS-NO-RETRY 1.000008 2020-03-06 08:17:29-08:00 America/Los_Angeles - Add --exclude-list option 1.000007 2020-03-05 13:55:01-08:00 America/Los_Angeles - Fix __FILE__ value in 'projects' command 1.000006 2020-03-03 15:32:49-08:00 America/Los_Angeles - Provide methods in TestFile that let you get/set retry 1.000005 2020-03-02 14:48:40-08:00 America/Los_Angeles - Use --qvf in test.pl for better output - Use -r1 in test.pl temporarily for some cpantesters 1.000004 2020-03-02 10:05:10-08:00 America/Los_Angeles - Switch away from sys-io in Util::File::Stream - Properly wrap FLOCK to handle interrupted syscalls - Remove unnecessary IPC::Open3 dep - Remove unnecessary Module::Pluggable dep - Add missing require statement 1.000003 2020-03-01 21:50:08-08:00 America/Los_Angeles - Do not run persistent tests in AUTOMATED_TESTING 1.000002 2020-03-01 21:19:04-08:00 America/Los_Angeles - Fix integration tests IO issues 1.000001 2020-02-29 10:49:11-08:00 America/Los_Angeles - Do not run tests on broken NJH smokers 1.000000 2020-02-28 09:30:47-08:00 America/Los_Angeles - No changes since last trial release - This is the first stable release - Huge changes/refactor from the alpha versions 0.999010 2020-02-27 21:52:25-08:00 America/Los_Angeles (TRIAL RELEASE) - Make signals.t author-testing - Cleanup failure-test - Show timeout delta when timing out a test 0.999009 2020-02-27 07:27:29-08:00 America/Los_Angeles (TRIAL RELEASE) - Fix sorting in ordering tests - Fix incorrect line numbers in plugin.t errors - Less fragile fork check in Makefile.PL 0.999008 2020-02-26 20:25:34-08:00 America/Los_Angeles (TRIAL RELEASE) - Only officially support systems with true fork(). 0.999007 2020-02-26 16:52:46-08:00 America/Los_Angeles (TRIAL RELEASE) - Fix IOStream permissions issues 0.999006 2020-02-26 15:39:28-08:00 America/Los_Angeles (TRIAL RELEASE) - Do not use IOEvents by default 0.999005 2020-02-25 14:02:01-08:00 America/Los_Angeles (TRIAL RELEASE) - Remove blib from tarball - Fix tests when outdated plugins are present 0.999004 2020-02-25 07:48:30-08:00 America/Los_Angeles (TRIAL RELEASE) - Warn+Skip when auto-loading outdated plugins 0.999003 2020-02-24 14:51:18-08:00 America/Los_Angeles (TRIAL RELEASE) - Fix older perls (down to 5.10) 0.999002 2020-02-24 08:56:06-08:00 America/Los_Angeles (TRIAL RELEASE) - Fix installation when an old yath is installed 0.999001 2020-02-23 15:42:47-08:00 America/Los_Angeles (TRIAL RELEASE) - Attempt to fix includes integration test 0.999000 2020-02-23 10:19:36-08:00 America/Los_Angeles (TRIAL RELEASE) - Huge refactor - Fix signal restoration for forked tests 0.001099 2019-09-09 21:12:15-07:00 America/Los_Angeles - Add --durations and --maybe_durations options 0.001098 2019-09-09 13:35:22-07:00 America/Los_Angeles - Add current dir to run data - Add rel/abs paths to harness_job_start/end 0.001097 2019-09-08 19:22:56-07:00 America/Los_Angeles - Add speedtag command 0.001096 2019-09-08 15:24:00-07:00 America/Los_Angeles - Cleanup help options a bit - Split category into category and duration - Clean up the ProcMan module - Tests start as their own process groups 0.001095 2019-09-04 15:38:07-07:00 America/Los_Angeles - Fix logging of plugin when it is blessed 0.001094 2019-09-04 14:44:55-07:00 America/Los_Angeles - Improve+Test SysInfo and Git Plugins 0.001093 2019-09-03 13:23:04-07:00 America/Los_Angeles - Add branch info to git data 0.001092 2019-09-03 10:32:46-07:00 America/Los_Angeles - Minor tweaks to SysInfo and Git plugins 0.001091 2019-08-30 14:03:19-07:00 America/Los_Angeles - Add Yath::Plugin::SysInfo 0.001090 2019-08-30 10:22:23-07:00 America/Los_Angeles - Allow specifying run-fields as JSON 0.001089 2019-08-30 09:05:59-07:00 America/Los_Angeles - Allow listing run-fields on the command line 0.001088 2019-08-29 23:23:47-07:00 America/Los_Angeles - Abstract and correct timing data collection 0.001087 2019-08-29 12:54:23-07:00 America/Los_Angeles - Fix incorrect timestamps 0.001086 2019-08-28 14:19:57-07:00 America/Los_Angeles - Fix overall harness run time where HiRes was only used for start time, not end time (sometimes resulting in a negative run time being printed) - Do not use Test2::Plugin::Times - Use event based timing data for -T - remove --times flag - Support for non-perl tests 0.001085 2019-08-21 16:49:20-07:00 America/Los_Angeles - Do not require DBIProfile yet until we need it (#111) - Standardize how fields are specified 0.001084 2019-08-16 20:08:48-07:00 America/Los_Angeles - Make More information available to plugins 0.001083 2019-08-16 19:55:17-07:00 America/Los_Angeles - Split out some plugins (DBIProfile, MemUsage, UUID) - No special treatment for plugins, they need to use INFO facets 0.001082 2019-08-15 11:03:22-07:00 America/Los_Angeles - Support 'END' phase in calculating times - Support super verbose mode in composer - Improvement ot DBIProfile - New minimum Test2 version 0.001081 2019-08-13 13:49:32-07:00 America/Los_Angeles - Add Git injection plugin - Add DBI Profile plugin - Calculate and record timing data 0.001080 2019-07-24 09:56:41-07:00 America/Los_Angeles - Make it possible to relocate the persistence file 0.001079 2019-07-05 12:56:06-07:00 America/Los_Angeles - Work around JSON::XS Bug 0.001078 2019-07-02 08:46:49-07:00 America/Los_Angeles - Document yath log format 0.001077 2019-06-06 15:04:32-07:00 America/Los_Angeles - Add --retry options (toddr) - Make sure all events are flushed if there is a sync issue - Added some tests 0.001076 2019-05-20 14:54:50-07:00 America/Los_Angeles - Fix TAP parsers nesting parsing - Dix comment groupign when parsing TAP 0.001075 2019-05-18 18:33:52-07:00 America/Los_Angeles - Fix Stream+IPC issues 0.001074 2019-05-07 12:04:51-07:00 America/Los_Angeles - Add support for table structures 0.001073 2019-04-10 08:21:04-07:00 America/Los_Angeles - Add support for disabled progress indicators to QVF mode 0.001072 2019-04-08 10:27:50-07:00 America/Los_Angeles - Add option to turn off progress indicators 0.001071 2018-12-13 09:43:38-08:00 America/Los_Angeles - Add --notify-text CLI option - Fix exit code parsing and reporting 0.001070 2018-10-24 13:19:53-07:00 America/Los_Angeles - Allow --author-testing in 'projects' command - Misc minor changes 0.001069 2018-08-23 13:48:54-07:00 America/Los_Angeles - Fix busy-spin in job reaper - Allow --no-fork and --no-preload simultaneously 0.001068 2018-07-27 09:12:45-07:00 America/Los_Angeles - Fix more encoding/utf8 bugs - Fix missing dep on sufficient List::Utils version 0.001067 2018-07-18 07:42:06-07:00 America/Los_Angeles - Add ability to congiure a custom log file format 0.001066 2018-07-12 08:06:46-07:00 America/Los_Angeles - Fix issue where isolation jobs were being kicked off too early. It needs to wait for all non-isolation jobs to finish first. - New Feature: # HARNESS-CONFLICTS-XXX - New documentation for HARNESS-CATEGORY-IMMISCIBLE - New documentation for HARNESS-TIMEOUT-EVENT - Get rid of the use of each when walking a hash. - Allow comment only lines prior to HARNESS-XXX directives - Accept binary TAP output that is not correctly formatted to UTF8 - Honor multiple spaces (or -) as a delimiter for # HARNESS directives 0.001065 2018-04-22 03:26:57-07:00 America/Los_Angeles - Fix utf8 double encoding error 0.001064 2018-03-29 22:47:10-07:00 America/Los_Angeles - Make it possible to chdir for a given test - Make run automatically chdir to the dir you were in when queuing tests - Add 'projects' command to run a dir with multiple projects 0.001063 2018-03-27 10:17:02-07:00 America/Los_Angeles - Make it possible to use relative paths in yath.rc 0.001062 2018-03-19 09:22:18-07:00 America/Los_Angeles - Fix bug where $, and $\ would break the formatters 0.001061 2018-03-14 12:47:28-07:00 America/Los_Angeles - No Changes since last trial 0.001060 2018-03-13 11:11:27-07:00 America/Los_Angeles (TRIAL RELEASE) - Fix parsing of streaming subtests 0.001059 2018-03-12 13:26:43-07:00 America/Los_Angeles - Job id's are now uuid's. Numbers for humans are now names - Use UUIDs for event IDs - Update min Test2 version 0.001058 2018-03-11 15:29:23-07:00 America/Los_Angeles - Fix broken tests - Record times by default, but only show when requested - Add memory usage - Do not add times from the harness itself - Add UUIDs to everything 0.001057 2018-03-07 08:09:18-08:00 America/Los_Angeles - No changes from last trial 0.001056 2018-03-06 13:47:08-08:00 America/Los_Angeles (TRIAL RELEASE) - Account for the 'hub' facet 0.001055 2018-03-05 20:10:24-08:00 America/Los_Angeles - Fix error where multiple procs read the same fh at once 0.001054 2018-03-02 09:05:44-08:00 America/Los_Angeles - Switch Streaming write() to use syswrite - Fix bug where jobs would re-run after a reload 0.001053 2018-02-27 07:15:53-08:00 America/Los_Angeles - No changes since last trial 0.001052 2018-02-06 15:03:08-08:00 America/Los_Angeles (TRIAL RELEASE) - Fix infinite recursion in closed subtests log json 0.001051 2018-02-06 13:29:38-08:00 America/Los_Angeles (TRIAL RELEASE) - Extract composer logic from Test2 formatter so it can be re-used - Revamp Watcher to stop mangling events - Onlt log processed events now by default (since mangling has stopped) 0.001050 2018-02-01 13:31:58-08:00 America/Los_Angeles - Allow logging of both processed and unprocessed events - Add finish() hook to loggers - This is a breaking change for any existing loggers (still alpha! Do not complain!) 0.001049 2018-01-26 14:27:16-08:00 America/Los_Angeles - Better 'renderer' handling 0.001048 2018-01-23 10:42:16-08:00 America/Los_Angeles - Make it possible to use multiple renderers at once - Fix return via next issue 0.001047 2018-01-19 21:58:13-08:00 America/Los_Angeles - Fix auto-reload for preload mode 0.001046 2018-01-18 10:47:31-08:00 America/Los_Angeles - Make --qvf show INTERNAL messages (#51) - Make -v override --qvf (#50) - Do not show 'no_display' about messages (#44) 0.001045 2018-01-05 08:38:05-08:00 America/Los_Angeles - Make it possible to toggle --qvf off - Show files being run in --qvf mode 0.001044 2018-01-02 07:25:06-08:00 America/Los_Angeles - Add post-run hook to plugins - Add -V/--version flags 0.001043 2017-12-19 10:12:22-08:00 America/Los_Angeles - Remove test for deleted file 0.001042 2017-12-18 15:03:26-08:00 America/Los_Angeles - Better scheduling simplification 0.001041 2017-12-06 11:01:16-08:00 America/Los_Angeles - Make realtime slack/email of failures possible - Add QVF (Quiet but verbose on failure) formatter 0.001040 2017-12-04 23:20:35-08:00 America/Los_Angeles - Fix filehandle IPC leak issue 0.001039 2017-12-04 21:54:24-08:00 America/Los_Angeles - Simplify scheduling 0.001038 2017-11-30 10:13:09-08:00 America/Los_Angeles - Minor fixes - Fix race condition/off by 1 when using the 'run' command 0.001037 2017-11-29 09:44:23-08:00 America/Los_Angeles - Add slack integrations - Add support for .yath.user.rc 0.001036 2017-11-28 10:26:36-08:00 America/Los_Angeles - Harness directives for meta-data - Add email capabilities 0.001035 2017-11-22 09:59:49-08:00 America/Los_Angeles - Fix infinite recrusion looking for .yathrc - Add 'failed' command 0.001034 2017-11-20 09:19:47-08:00 America/Los_Angeles - Prevent deadlock on win32 (tests do not pass yet in win32) 0.001033 2017-11-18 16:16:52-08:00 America/Los_Angeles - Add a summarize_events to Test2::Tools::HarnessTester 0.001032 2017-11-15 08:44:40-08:00 America/Los_Angeles - Add an extra @INC hook in persistent mode for dep tracing 0.001031 2017-11-03 09:18:56-07:00 America/Los_Angeles - Remove Debug tool that used sigusr1 - Fix support for perls as far back as 5.8.9 0.001030 2017-11-01 13:24:17-07:00 America/Los_Angeles - Make tests work witohut old version installed - Do not use shm by default - add tests for replay command - better test.pl - use clone_io instead of hand rolling it (Formatter) - doc fixes - make sure test.pl does not run itself 0.001029 2017-10-31 14:53:52-07:00 America/Los_Angeles - Move away from IPC::Open3 0.001028 2017-10-31 09:35:23-07:00 America/Los_Angeles - More test coverage improvements 0.001027 2017-10-27 15:11:57-07:00 America/Los_Angeles - Do not inject a HASHREF as an env var key - Improved test coverage - Added a test helper for commands (including third party ones) - Do not remove newlines from stdout - Merge sequential stdout/stderr lines - Add minimal test descriptions 0.001026 2017-10-24 10:00:34-07:00 America/Los_Angeles - Fix a couple commands that broke due ot @INC fixes 0.001025 2017-10-24 09:40:28-07:00 America/Los_Angeles - Require a newer goto-file to avoid changing exceptions - Allow control of default search locations - stop command now prints all to stdout 0.001024 2017-10-23 12:12:53-07:00 America/Los_Angeles - Make sure @INC is set as soon as possible - Do not let a file hide a command 0.001023 2017-10-20 22:16:33-07:00 America/Los_Angeles - Update to a newer HashBase 0.001022 2017-10-20 07:12:19-07:00 America/Los_Angeles - Minor test updates 0.001021 2017-10-13 11:02:22-07:00 America/Los_Angeles - More @INC corrections - DepTracer no longer mangles caller. 0.001020 2017-10-13 07:34:02-07:00 America/Los_Angeles - Use the correct @INC in all preload methods 0.001019 2017-10-11 10:08:14-07:00 America/Los_Angeles - Don't call find_yath() if we already found a yath (Matthew Horsfall) - Minor display optimizations 0.001018 2017-10-10 14:42:16-07:00 America/Los_Angeles - Fix a DESTROY typo (Michael McClimon) - Test2::Harness namespace does not use App::Yath namespace - Package delcaration allowed before harness directives - When respawning a stage may exit badly, nobody cares - Fix scheduling properly this time - Record timing data for all events - Stop using expensive canonical JSON for logs - Better $0 handling 0.001017 2017-10-07 16:24:01-07:00 America/Los_Angeles - Fix scheduling - Add 'times' tool - Put skip reason on same line as filename 0.001016 2017-10-03 07:14:08-07:00 America/Los_Angeles - More test coverage - Added --cover option - Added --dummy option - Improved 'start', 'stop', and 'run' - Remove chdir option - Fix broken replay command - Fix some deadlock conditions - Cleaner output - Do not wrap long output lines when output is not a terminal - DZIL generates some docs now - Minor bug fixes and improvements - Improved performance of the parser - Add # HARNESS-TIMEOUT-[TYPE] ## header support - Add -q|--quiet mode - Do not try to kill job after post-exit timeout - Remove the tcm plugin (it is failure) - Handle sync points when incomplete lines are written 0.001015 2017-09-15 08:55:30-07:00 America/Los_Angeles - Put lib, blib, and -I's before system libs (Fixes #31) - Bump minimum goto-file version (Fixes #30) - Use $Config for path seperator instead of ':' 0.001014 2017-09-14 21:27:29-07:00 America/Los_Angeles - Pass-Through $ENV{PERL5LIB} 0.001013 2017-09-14 18:29:49-07:00 America/Los_Angeles - Put back code that was accidentally removed 0.001012 2017-09-14 15:19:19-07:00 America/Los_Angeles - Fix dep list 0.001011 2017-09-14 14:27:32-07:00 America/Los_Angeles - Fix bug where no-fork skipped tests - Use relative paths for tests in $0, __FILE__, and caller 0.001010 2017-09-14 10:31:35-07:00 America/Los_Angeles - Pull out the filter into goto::file - Do not use filter for tests that come back as subrefs - Improve TCM plugin - Fix timeouts (again) - Remove unused variable - Stop waiting for a test once it is killed - Fix Typos - Some bug fixes 0.001009 2017-09-12 23:10:05-07:00 America/Los_Angeles - Better docs - More testing - Minor bug fixes 0.001008 2017-09-12 13:49:05-07:00 America/Los_Angeles NOW Feature-complete! (Needs docs and tests) - Fix dep versions in dist.ini - Improve test coverage - Better test.pl detection by yath command - Add color/no-color options - Support for project .yath.rc files - Make sure $VERSION is in correct files - Add 'help' command - Add 'init' command - More hooks for preload modules - Several bug fixes - Make it so that preload+fork does not add a stack layer - unify to only one 'yath' script - Split persist into multiple commands - Create a plugin system, Add TCM plugin to split out later - Remove pre-import option - Better default log location+name - Move CommandShared/Harness -> App/Command.pm - Add --no-long option - Add --exclude option - Bind lib & blib earlier, use absolute paths - Fix parser error on '}' - Allow -w in tests after preload - Handle timers better 0.001007 2017-09-11 21:40:28-07:00 America/Los_Angeles - Properly pass args given via '::' - Honor NO-STREAM header - Persist now reloads when a file is changed 0.001006 2017-09-06 14:24:18-07:00 America/Los_Angeles (TRIAL RELEASE) - Fix replay - Add pre-import - Add load and load-import options - Add persistent harness 0.001005 2017-09-05 21:59:21-07:00 America/Los_Angeles (TRIAL RELEASE) - Fix some bugs - Remove accidentally added file - Do not hang when waiting after control+c - Restructure Run/Runner to be more sane - Fix bugs, break out test file and queue - Add extra space in help dialog - Restructure common command options - Better queue handling - Put test and replay common logic in one place - Fix bugs in replay - Put common logic for test and replay commands in a single place. 0.001004 2017-08-31 21:02:34-07:00 America/Los_Angeles - Make test.pl ok with preload - Fix Formatter::Test2 for non-tty output - Add -T for timing data per-test - Better signal handling - More HARNESS- header options: - HARNESS-NO-TIMEOUT - Delete job dirs when they are done unless -k is used 0.001003 2017-08-30 23:18:54-07:00 America/Los_Angeles (TRIAL RELEASE) - Set env vars in the run-runner for preload - Improve preload support - Fix formatter selection in Open3 runner - Update deps 0.001002 2017-08-29 21:10:17-07:00 America/Los_Angeles - Allow preload of Test::Builder 0.001001 2017-08-28 22:40:20-07:00 America/Los_Angeles (TRIAL RELEASE) - Complete rewrite 0.000013 2017-01-03 21:18:19-08:00 America/Los_Angeles - Add event timeout option - Fix filename rendering when a test is done - Fixed handling of a "plan skip_all" issued in the main test (as opposed to a subtest). Partially fixes GitHub #21, reported by rjbs. - When a test file doesn't run any tests but exits successfully, this was treated as a pass. This is now detected and generates different output indicating that the process did not run any tests. Fixes the rest of GitHub #21, reported by rjbs. 0.000012 2016-12-19 11:46:41-08:00 America/Los_Angeles (TRIAL RELEASE) - Fixed #9, environment now set properly in preload mode - Job listeners now receive the Test2::Harness::Job object as the first argument, rather than just the job id. - Fixed the TAP parser to handle comments with leading whitespace. Previously it would strip all the leading whitespace out, causing both "# foo" and "# foo" to be output the same way. - Add example for using the harness as a preload test file - Document using Test2::Harness as a preload test runner - Rewrote all of the internals so that the harness now handles Test2 events directly, rather than converting them into Test2::Harness::Fact objects. The facts were losing some details of the events, and the event system already exists and is usable with the harness simply by adding some new harness-specific events. Implemented by Dave Rolsky. GitHub #20. 0.000011 2016-06-10 14:11:01-07:00 America/Los_Angeles - Fix rendering todo subtests... 0.000010 2016-06-10 13:39:27-07:00 America/Los_Angeles - More complete todo subtest fix 0.000009 2016-06-10 13:02:11-07:00 America/Los_Angeles - Fix TAP parsing bug when buffered subtests are TODO 0.000008 2016-05-31 07:35:46-07:00 America/Los_Angeles - Lower the IO::Handle version req 0.000007 2016-05-28 16:31:35-07:00 America/Los_Angeles - Try to fix JSON encoding problem 0.000006 2016-05-26 20:28:27-07:00 America/Los_Angeles (TRIAL RELEASE) - Fix Data::Dumper typo >:-| 0.000005 2016-05-26 08:48:12-07:00 America/Los_Angeles (TRIAL RELEASE) - Add missing JSON prototype in Fact.pm - Add diagnostics when fact->to_json fails 0.000004 2016-05-26 08:35:04-07:00 America/Los_Angeles - Handle -I better in the runner - Make IO::Pty tests AUTHOR_TESTING only. - Add IO::Pty to diagnostics output - Diagnostics to show which JSON gets used 0.000003 2016-05-25 11:55:51-07:00 America/Los_Angeles - Get path separator from config - Better windows prereq specification - Handle buffered usbtest race condition 0.000002 2016-05-25 09:22:22-07:00 America/Los_Angeles - Die if given unknown command line flags. Patch by Dave Rolsky. GitHub #1. - Added -l (--lib) and -b (--blib) flags that work just like prove. Patch by Dave Rolsky. GitHub #2. - Better prereq list - Diagnostic test output - Old version and cross platform support 0.000001 2016-05-24 17:04:13-07:00 America/Los_Angeles - Initial Release ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/LICENSE����������������������������������������������������������������������0000644�0001750�0001750�00000046424�15012417054�015310� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������This software is copyright (c) 2025 by Chad Granum. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2025 by Chad Granum. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. <one line to give the program's name and a brief idea of what it does.> Copyright (C) 19yy <name of author> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. <signature of Ty Coon>, 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Perl Artistic License 1.0 --- This software is Copyright (c) 2025 by Chad Granum. This is free software, licensed under: The Perl Artistic License 1.0 The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2-Harness-1.000158/README�����������������������������������������������������������������������0000644�0001750�0001750�00000040702�15012417054�015154� 0����������������������������������������������������������������������������������������������������ustar �exodist�������������������������exodist����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������NAME App::Yath - Yet Another Test Harness (Test2-Harness) Command Line Interface (CLI) DESCRIPTION This is the primary documentation for yath, App::Yath, Test2::Harness. The canonical source of up-to-date command options are the help output when using $ yath help and $ yath help COMMAND. This document is mainly an overview of yath usage and common recipes. App::Yath is an alternative to App::Prove, and Test2::Harness is an alternative to Test::Harness. It is not designed to replace Test::Harness/prove. Test2::Harness is designed to take full advantage of the rich data Test2 can provide. Test2::Harness is also able to use non-core modules and provide more functionality than prove can achieve with its restrictions. PLATFORM SUPPORT Test2::Harness/App::Yath is is focused on unix-like platforms. Most development happens on linux, but bsd, macos, etc should work fine as well. Patches are welcome for any/all platforms, but the primary author (Chad 'Exodist' Granum) does not directly develop against non-unix platforms. WINDOWS Currently windows is not supported, and it is known that the package will not install on windows. Patches are be welcome, and it would be great if someone wanted to take on the windows-support role, but it is not a primary goal for the project. OVERVIEW To use Test2::Harness, you use the yath command. Yath will find the tests (or use the ones you specify) and run them. As it runs, it will output diagnostic information such as failures. At the end, yath will print a summary of the test run. yath can be thought of as a more powerful alternative to prove (Test::Harness) RECIPES These are common recipes for using yath. RUN PROJECT TESTS $ yath Simply running yath with no arguments means "Run all tests for the current project". Yath will look for tests in ./t, ./t2, and ./test.pl and run any which are found. Normally this implies the test command but will instead imply the run command if a persistent test runner is detected. PRELOAD MODULES Yath has the ability to preload modules. Yath normally forks to start new tests, so preloading can reduce the time spent loading modules over and over in each test. Note that some tests may depend on certain modules not being loaded. In these cases you can add the # HARNESS-NO-PRELOAD directive to the top of the test files that cannot use preload. SIMPLE PRELOAD Any module can be preloaded: $ yath -PMoose You can preload as many modules as you want: $ yath -PList::Util -PScalar::Util COMPLEX PRELOAD If your preload is a subclass of Test2::Harness::Runner::Preload then more complex preload behavior is possible. See those docs for more info. LOGGING RECORDING A LOG You can turn on logging with a flag. The filename of the log will be printed at the end. $ yath -L ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl The event log can be quite large. It can be compressed with bzip2. $ yath -B ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 gzip compression is also supported. $ yath -G ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.gz -B and -G both imply -L. REPLAYING FROM A LOG You can replay a test run from a log file: $ yath test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 This will be significantly faster than the initial run as no tests are actually being executed. All events are simply read from the log, and processed by the harness. You can change display options and limit rendering/processing to specific test jobs from the run: $ yath test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 -v [TEST UUID(S)] Note: This is done using the $ yath replay ... command. The replay command is implied if the first argument is a log file. PER-TEST TIMING DATA The -T option will cause each test file to report how long it took to run. $ yath -T ( PASSED ) job 1 t/yath_script.t ( TIME ) job 1 Startup: 0.07692s | Events: 0.01170s | Cleanup: 0.00190s | Total: 0.09052s PERSISTENT RUNNER yath supports starting a yath session that waits for tests to run. This is very useful when combined with preload. STARTING This starts the server. Many options available to the 'test' command will work here but not all. See $ yath help start for more info. $ yath start RUNNING This will run tests using the persistent runner. By default, it will search for tests just like the 'test' command. Many options available to the test command will work for this as well. See $ yath help run for more details. $ yath run STOPPING Stopping a persistent runner is easy. $ yath stop INFORMATIONAL The which command will tell you which persistent runner will be used. Yath searches for the persistent runner in the current directory, then searches in parent directories until it either hits the root directory, or finds the persistent runner tracking file. $ yath which The watch command will tail the runner's log files. $ yath watch PRELOAD + PERSISTENT RUNNER You can use preloads with the yath start command. In this case, yath will track all the modules pulled in during preload. If any of them change, the server will reload itself to bring in the changes. Further, modified modules will be blacklisted so that they are not preloaded on subsequent reloads. This behavior is useful if you are actively working on a module that is normally preloaded. MAKING YOUR PROJECT ALWAYS USE YATH $ yath init The above command will create test.pl. test.pl is automatically run by most build utils, in which case only the exit value matters. The generated test.pl will run yath and execute all tests in the ./t and/or ./t2 directories. Tests in ./t will ALSO be run by prove but tests in ./t2 will only be run by yath. PROJECT-SPECIFIC YATH CONFIG You can write a .yath.rc file. The file format is very simple. Create a [COMMAND] section to start the configuration for a command and then provide any options normally allowed by it. When yath is run inside your project, it will use the config specified in the rc file, unless overridden by command line options. Note: You can also add pre-command options by placing them at the top of your config file BEFORE any [cmd] markers. Comments start with a semi-colon. Example .yath.rc: -pFoo ; Load the 'foo' plugin before dealing with commands. [test] -B ;Always write a bzip2-compressed log [start] -PMoose ;Always preload Moose with a persistent runner This file is normally committed into the project's repo. SPECIAL PATH PSEUDO-FUNCTIONS Sometimes you want to specify files relative to the .yath.rc so that the config option works from any subdirectory of the project. Other times you may wish to use a shell expansion. Sometimes you want both! rel(path/to/file) -I rel(path/to/extra_lib) -I=rel(path/to/extra_lib) This will take the path to .yath.rc and prefix it to the path inside rel(...). If for example you have /project/.yath.rc then the path would become /project/path/to/extra_lib. glob(path/*/file) --default-search glob(subprojects/*/t) --default-search=glob(subprojects/*/t) This will add a --default-search $_ for every item found in the glob. This uses the perl builtin function glob() under the hood. relglob(path/*/file) --default-search relglob(subprojects/*/t) --default-search=relglob(subprojects/*/t) Same as glob() except paths are relative to the .yath.rc file. PROJECT-SPECIFIC YATH CONFIG USER OVERRIDES You can add a .yath.user.rc file. Format is the same as the regular .yath.rc file. This file will be read in addition to the regular config file. Directives in this file will come AFTER the directives in the primary config so it may be used to override config. This file should not normally be committed to the project repo. HARNESS DIRECTIVES INSIDE TESTS yath will recognise a number of directive comments placed near the top of test files. These directives should be placed after the #! line but before any real code. Real code is defined as any line that does not start with use, require, BEGIN, package, or # good example 1 #!/usr/bin/perl # HARNESS-NO-FORK ... good example 2 #!/usr/bin/perl use strict; use warnings; # HARNESS-NO-FORK ... bad example 1 #!/usr/bin/perl # blah # HARNESS-NO-FORK ... bad example 2 #!/usr/bin/perl print "hi\n"; # HARNESS-NO-FORK ... HARNESS-NO-PRELOAD #!/usr/bin/perl # HARNESS-NO-PRELOAD Use this if your test will fail when modules are preloaded. This will tell yath to start a new perl process to run the script instead of forking with preloaded modules. Currently this implies HARNESS-NO-FORK, but that may not always be the case. HARNESS-NO-FORK #!/usr/bin/perl # HARNESS-NO-FORK Use this if your test file cannot run in a forked process, but instead must be run directly with a new perl process. This implies HARNESS-NO-PRELOAD. HARNESS-NO-STREAM yath usually uses the Test2::Formatter::Stream formatter instead of TAP. Some tests depend on using a TAP formatter. This option will make yath use Test2::Formatter::TAP or Test::Builder::Formatter. HARNESS-NO-IO-EVENTS yath can be configured to use the Test2::Plugin::IOEvents plugin. This plugin replaces STDERR and STDOUT in your test with tied handles that fire off proper Test2::Event's when they are printed to. Most of the time this is not an issue, but any fancy tests or modules which do anything with STDERR or STDOUT other than print may have really messy errors. Note: This plugin is disabled by default, so you only need this directive if you enable it globally but need to turn it back off for select tests. HARNESS-NO-TIMEOUT yath will usually kill a test if no events occur within a timeout (default 60 seconds). You can add this directive to tests that are expected to trip the timeout, but should be allowed to continue. NOTE: you usually are doing the wrong thing if you need to set this. See: HARNESS-TIMEOUT-EVENT. HARNESS-TIMEOUT-EVENT 60 yath can be told to alter the default event timeout from 60 seconds to another value. This is the recommended alternative to HARNESS-NO-TIMEOUT HARNESS-TIMEOUT-POSTEXIT 15 yath can be told to alter the default POSTEXIT timeout from 15 seconds to another value. Sometimes a test will fork producing output in the child while the parent is allowed to exit. In these cases we cannot rely on the original process exit to tell us when a test is complete. In cases where we have an exit, and partial output (assertions with no final plan, or a plan that has not been completed) we wait for a timeout period to see if any additional events come into HARNESS-DURATION-LONG This lets you tell yath that the test file is long-running. This is primarily used when concurrency is turned on in order to run longer tests earlier, and concurrently with shorter ones. There is also a yath option to skip all long tests. This duration is set automatically if HARNESS-NO-TIMEOUT is set. HARNESS-DURATION-MEDIUM This lets you tell yath that the test is medium. This is the default duration. HARNESS-DURATION-SHORT This lets you tell yath That the test is short. HARNESS-CATEGORY-ISOLATION This lets you tell yath that the test cannot be run concurrently with other tests. Yath will hold off and run these tests one at a time after all other tests. HARNESS-CATEGORY-IMMISCIBLE This lets you tell yath that the test cannot be run concurrently with other tests of this class. This is helpful when you have multiple tests which would otherwise have to be run sequentially at the end of the run. Yath prioritizes running these tests above HARNESS-CATEGORY-LONG. HARNESS-CATEGORY-GENERAL This is the default category. HARNESS-CONFLICTS-XXX This lets you tell yath that no other test of type XXX can be run at the same time as this one. You are able to set multiple conflict types and yath will honor them. XXX can be replaced with any type of your choosing. NOTE: This directive does not alter the category of your test. You are free to mark the test with LONG or MEDIUM in addition to this marker. HARNESS-JOB-SLOTS 2 HARNESS-JOB-SLOTS 1 10 Specify a range of job slots needed for the test to run. If set to a single value then the test will only run if it can have the specified number of slots. If given a range the test will require at least the lower number of slots, and use up to the maximum number of slots. Example with multiple lines. #!/usr/bin/perl # DASH and space are split the same way. # HARNESS-CONFLICTS-DAEMON # HARNESS-CONFLICTS MYSQL ... Or on a single line. #!/usr/bin/perl # HARNESS-CONFLICTS DAEMON MYSQL ... HARNESS-RETRY-n This lets you specify a number (minimum n=1) of retries on test failure for a specific test. HARNESS-RETRY-1 means a failing test will be run twice and is equivalent to HARNESS-RETRY. HARNESS-NO-RETRY Use this to avoid this test being retried regardless of your retry settings. MODULE DOCS This section documents the App::Yath module itself. SYNOPSIS In practice you should never need to write your own yath script, or construct an App::Yath instance, or even access themain instance when yath is running. However some aspects of doing so are documented here for completeness. A minimum yath script looks like this: BEGIN { package App::Yath:Script; require Time::HiRes; require App::Yath; require Test2::Harness::Settings; my $settings = Test2::Harness::Settings->new( harness => { orig_argv => [@ARGV], orig_inc => [@INC], script => __FILE__, start => Time::HiRes::time(), version => $App::Yath::VERSION, }, ); my $app = App::Yath->new( argv => \@ARGV, config => {}, settings => $settings, ); $app->generate_run_sub('App::Yath::Script::run'); } exit(App::Yath::Script::run()); It is important that most logic live in a BEGIN block. This is so that goto::file can be used post-fork to execute a test script. The actual yath script is significantly more complicated with the following behaviors: pre-process essential arguments such as -D and no-scan-plugins re-exec with a different yath script if in developer mode and a local copy is found Parse the yath-rc config files gather and store essential startup information METHODS App::Yath does not provide many methods to use externally. $app->generate_run_sub($symbol_name) This tells App::Yath to generate a subroutine at the specified symbol name which can be run and be expected to return an exit value. $lib_path = $app->app_path() Get the include directory App::Yath was loaded from. SOURCE The source code repository for Test2-Harness can be found at http://github.com/Test-More/Test2-Harness/. MAINTAINERS Chad Granum <exodist@cpan.org> AUTHORS Chad Granum <exodist@cpan.org> COPYRIGHT Copyright 2020 Chad Granum <exodist7@gmail.com>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See http://dev.perl.org/licenses/ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������