From d5f9ea2a02f50b533df5bc6a03707e7806595160 Mon Sep 17 00:00:00 2001 From: Dimitrios Kechagias Date: Sat, 29 Jun 2024 06:08:58 +0100 Subject: [PATCH 1/7] agg helper script, pass_only option --- .github/workflows/ci.yml | 35 ++++++++++++ .gitignore | 19 +++++++ MANIFEST | 1 + Makefile.PL | 1 + README | 6 -- README.pod | 2 +- agg | 120 +++++++++++++++++++++++++++++++++++++++ lib/Test2/Aggregate.pm | 14 ++++- 8 files changed, 189 insertions(+), 9 deletions(-) create mode 100644 .github/workflows/ci.yml create mode 100644 .gitignore create mode 100755 agg diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 0000000..666dba5 --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,35 @@ +name: CI + +on: + push: + +jobs: + linux: + runs-on: ubuntu-latest + + strategy: + fail-fast: false + matrix: + perl-version: + - '5.40' + - '5.36' + - '5.32' + - '5.28' + - '5.24' + - '5.20' + - '5.16' + - '5.12' + - '5.8' + + container: + image: perldocker/perl-tester:${{ matrix.perl-version }} + + steps: + - uses: actions/checkout@main + with: + submodules: recursive + - run: perl -V + - run: cpanm --notest --installdeps --verbose . + - run: perl Makefile.PL + - run: make + - run: prove -wlvmb t \ No newline at end of file diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c24ae2c --- /dev/null +++ b/.gitignore @@ -0,0 +1,19 @@ +MANIFEST.bak +Makefile +Makefile.old +Build +Build.bat +META.* +MYMETA.* +.build/ +_build/ +cover_db/ +blib/ +inc/ +.lwpcookies +.last_cover_stats +nytprof.out +pod2htm*.tmp +pm_to_blib +Test2-Aggregate-* +Test2-Aggregate-*.tar.gz diff --git a/MANIFEST b/MANIFEST index d2c17e8..81de6f1 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,3 +1,4 @@ +agg Changes lib/Test2/Aggregate.pm Makefile.PL diff --git a/Makefile.PL b/Makefile.PL index 976fd91..34dec62 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -19,6 +19,7 @@ my %WriteMakefileArgs = ( CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => '0', }, + EXE_FILES => ["agg"], TEST_REQUIRES => { 'Test::Output' => '0', 'Test2::V0' => '0' diff --git a/README b/README index 03f4436..625815d 100644 --- a/README +++ b/README @@ -23,12 +23,6 @@ You can also look for information at: RT, CPAN's request tracker (report bugs here) https://rt.cpan.org/NoAuth/Bugs.html?Dist=Test2-Aggregate - AnnoCPAN, Annotated CPAN documentation - http://annocpan.org/dist/Test2-Aggregate - - CPAN Ratings - https://cpanratings.perl.org/d/Test2-Aggregate - Search CPAN https://metacpan.org/release/Test2-Aggregate diff --git a/README.pod b/README.pod index e3f49cf..bd1388e 100644 --- a/README.pod +++ b/README.pod @@ -219,7 +219,7 @@ the output to C, C etc). =item * C (optional) -This option exist to make the default output format of C be fixed, +This option exists to make the default output format of C be fixed, but still allow additions in future versions that will only be written with the C option enabled. Additions with C as of the current version: diff --git a/agg b/agg new file mode 100755 index 0000000..8544170 --- /dev/null +++ b/agg @@ -0,0 +1,120 @@ +#!/usr/bin/env perl + +=head1 NAME + +agg - Test2::Aggregate harness wrapper + +=head1 DESCRIPTION + +Pass Perl test files/directories and they will run aggregated via yath or prove. + +It is useful either to speed up a test run for tests you know can be aggregated, +or to check whether specific tests can pass under Test2::Aggregate. + +=head1 SYNOPSIS + + agg [options] + + Options: + --out , -o : Specify the test file to be created (tmp file by default). + --prove, -p : Force prove (default is yath if detected). + --verbose, -v : Verbose (passed to yath/prove) + --include , -I : Library paths to include. + --test_warnings, -w : Fail tests on warnings. + --test_bundle , -t : Test bundle (default: Test2::V0). Can be comma-separated list. + --pass_list , -l : Output directory for list of 100% passing tests. + --stats_output , -s : Stats output directory (does not combine with pass_list). + --help -h : Show basic help and exit. + +=cut + +use strict; +use warnings; + +use lib 'lib'; + +use Cwd; +use File::Temp 'tempfile'; +use Getopt::Long; +use Path::Tiny; +use Pod::Usage; + +my %opt = (framework => 'Test2::V0'); +GetOptions( + \%opt, + 'help|h', + 'include|I=s', + 'out|o=s', + 'pass_list|l=s', + 'prove|p', + 'stats_output|s=s', + 'test_bundle|t=s', + 'test_warnings|w', + 'verbose|v', +); + +pod2usage({-verbose => 1, -output => \*STDOUT, -noperldoc => 1}) + if $opt{help} || !@ARGV; + +$opt{test_bundle} ||= 'Test2::V0'; +$opt{stats_output} = $opt{pass_list} if $opt{pass_list}; + +unless ($opt{prove}) { + my $res = `which yath`; + $opt{prove} = 1 unless $res; +} + +my $file = $opt{out} ? path($opt{out}) : Path::Tiny->tempfile( + TEMPLATE => "aggXXXXXX", + SUFFIX => '.t', + UNLINK => 0 +); + +print "Writing output to $file\n" if $opt{verbose}; + +my $cwd = getcwd(); +my $code = test_bundle_use($opt{test_bundle}); + +$code .= " +use Test2::Aggregate; + +my \$stats = Test2::Aggregate::run_tests( +"; +$code .= "\ttest_warnings => 1,\n" if $opt{test_warnings}; +$code .= "\tstats_output => '$opt{stats_output}',\n" if $opt{stats_output}; +$code .= "\tpass_only => 1,\n" if $opt{pass_only}; +$code .= "\tdirs => [\n"; +$code .= join(",\n", map {"'$_'"} normalize_paths($cwd, @ARGV)); +$code .= "\n\t], +); +done_testing(); +"; + +$file->spew_utf8($code); + +my $cmd = $opt{prove} ? 'prove' : 'yath'; +my @args = ($file); +unshift @args, '-v' if $opt{verbose}; +unshift @args, "-I$opt{include}" if $opt{include}; +unshift @args, 'test' unless $opt{prove}; + +exec($cmd, @args); + +sub test_bundle_use { + my @modules = split /,/, shift; + my $str = ''; + $str .= "use $_;\n" for @modules; + return $str; +} + +sub normalize_paths { + my $cwd = shift; + my @paths = @_; + my @norm; + + $cwd =~ s#/?$#/#; + + push @norm, (substr($_, 0, 1) eq '/' ? $_ : "$cwd$_") for @paths; + + return @norm; +} diff --git a/lib/Test2/Aggregate.pm b/lib/Test2/Aggregate.pm index d3a86df..f06a744 100644 --- a/lib/Test2/Aggregate.pm +++ b/lib/Test2/Aggregate.pm @@ -79,6 +79,7 @@ have less issues with L (see notes). override => \%override, # optional, requires Sub::Override stats_output => $stats_output_path, # optional extend_stats => 0, # optional + pass_only => 0, # optional test_warnings => 0, # optional allow_errors => 0, # optional pre_eval => $code_to_eval, # optional @@ -239,6 +240,11 @@ but still allow additions in future versions that will only be written with the C option enabled. Additions with C as of the current version: +=item * C (optional) + +Modifies C by making it only print out a list of passing tests. +Useful for creating lists of aggregateable tests. + =over 4 - starting date/time in ISO_8601. @@ -449,16 +455,20 @@ sub _print_stats { my $total = 0; my $extra = $args->{extend_stats} ? ' TIMESTAMP' : ''; - print $fh "TIME PASS%$extra TEST\n"; + print $fh "TIME PASS%$extra TEST\n" unless $args->{pass_only}; foreach my $test (sort {$stats->{$b}->{time}<=>$stats->{$a}->{time}} keys %$stats) { + if ($args->{pass_only}) { + print $fh "$test\n" if $stats->{$test}->{pass_perc} > 99; + next; + } $extra = ' '.$stats->{$test}->{timestamp} if $args->{extend_stats}; $total += $stats->{$test}->{time}; printf $fh "%.2f %d$extra $test\n", $stats->{$test}->{time}, $stats->{$test}->{pass_perc}; } - printf $fh "TOTAL TIME: %.1f sec\n", $total; + printf $fh "TOTAL TIME: %.1f sec\n", $total unless $args->{pass_only}; close $fh unless $args->{stats_output} =~ /^-$/; } From 372fbb7fb1cc62ade8b350e84bada02fcb06b02c Mon Sep 17 00:00:00 2001 From: Dimitrios Kechagias Date: Sat, 29 Jun 2024 06:57:22 +0100 Subject: [PATCH 2/7] add POD and test --- agg | 3 +- lib/Test2/Aggregate.pm | 77 ++++++++++++++++++++++++++---------------- t/stats.t | 14 +++++++- 3 files changed, 63 insertions(+), 31 deletions(-) diff --git a/agg b/agg index 8544170..8c9839c 100755 --- a/agg +++ b/agg @@ -6,7 +6,8 @@ agg - Test2::Aggregate harness wrapper =head1 DESCRIPTION -Pass Perl test files/directories and they will run aggregated via yath or prove. +Pass a list of Perl test files/directories and they will run aggregated via yath +(or prove if specified). It is useful either to speed up a test run for tests you know can be aggregated, or to check whether specific tests can pass under Test2::Aggregate. diff --git a/lib/Test2/Aggregate.pm b/lib/Test2/Aggregate.pm index f06a744..fc73025 100644 --- a/lib/Test2/Aggregate.pm +++ b/lib/Test2/Aggregate.pm @@ -26,11 +26,11 @@ Test2::Aggregate - Aggregate tests for increased speed =head1 VERSION -Version 0.17 +Version 0.18 =cut -our $VERSION = '0.17'; +our $VERSION = '0.18'; =head1 DESCRIPTION @@ -565,47 +565,66 @@ disable warnings on redefines only for tests that run aggregated: Another idea is to make the test die when it is run under the aggregator, if, at design time, you know it is not supposed to run aggregated. +=head2 agg helper script + + agg [options] + +Pass a list of Perl test files/directories and they will run aggregated via yath +(or prove if specified). + + Options: + --out , -o : Specify the test file to be created (tmp file by default). + --prove, -p : Force prove (default is yath if detected). + --verbose, -v : Verbose (passed to yath/prove) + --include , -I : Library paths to include. + --test_warnings, -w : Fail tests on warnings. + --test_bundle , -t : Test bundle (default: Test2::V0). Can be comma-separated list. + --pass_list , -l : Output directory for list of 100% passing tests. + --stats_output , -s : Stats output directory (does not combine with pass_list). + --help -h : Show basic help and exit. + =head2 Example aggregating strategy There are many approaches you could do to use C with an existing -test suite, so for example you can start by making a list of the test files you -are trying to aggregate: +test suite, usually involving an iterative process of trying to run several tests +aggregated, seeing if you can fix the failing ones, otherwise you remove them from +the aggregation etc. - find t -name '*.t' > all.lst +This process can be done with the help of the C script. For example, to try +all tests under C aggregated and a list of passing tests put under the C +directory you would do: -If you have a substantial test suite, perhaps try with a portion of it (a subdir?) -instead of the entire suite. In any case, try running them aggregated like this: + > agg -p pass t - use Test2::Aggregate; - use Test2::V0; # Or Test::More; +If the run completes, you have a "starting point" - i.e. a .txt list that can run +under the aggregator with the C option: - my $stats = Test2::Aggregate::run_tests( - lists => ['all.lst'], + Test2::Aggregate::run_tests( + lists => ['pass/name_of_file.txt'] ); - open OUT, ">pass.lst"; - foreach my $test (sort {$stats->{$a}->{test_no} <=> $stats->{$b}->{test_no}} keys %$stats) { - print OUT "$test\n" if $stats->{$test}->{pass_perc}; - } - close OUT; - - done_testing(); +If the run does not complete, try fewer tests by choosing just a subdirectory. If +that's not possible, you'll probably have to go to the more manual method of getting +a full list of your tests (C all.lst>) then trying to run +parts of it, again with the C option. -Run the above with C or C in verbose mode, so that in case the run -hangs (it can happen), you can see where it did so and edit C removing -the offending test. - -If the run completes, you have a "starting point" - i.e. a list that can run under -the aggregator in C. -You can try adding back some of the failed tests - test failures can be cascading, -so some might be passing if added back, or have small issues you can address. +After you have a starting point, you can try see if there is an obvious reason some +tests fail and address it to add them back to the pass list. You can even try adding +back some of the failed tests that were not among the first to fail - test failures +can sometimes be cascading, so some might be passing if added back, or have small +issues you can address. Try adding C 1> to C to fix warnings as well, unless it is common for your tests to have C output. -To have your entire suite run aggregated tests together once and not repeat them -along with the other, non-aggregated, tests, it is a good idea to use the -C<--exclude-list> option of the C. +In the end, you will end up with part of your tests aggregated in (multiple if you +want to run them in parallel) list files, with the rest of your tests to be run +non-aggregated. + +You don't actually have to move and separate aggregated/non-aggregated files when +using lists, you can still have your entire suite run the aggregated tests once and +not repeat them along with the other, non-aggregated tests, by taking advantage of +the C<--exclude-list> option of the C. Hopefully your tests can run in parallel (C), in which case you would split your aggregated tests into multiple lists to have them run in parallel. diff --git a/t/stats.t b/t/stats.t index ded3c75..951cb23 100644 --- a/t/stats.t +++ b/t/stats.t @@ -9,7 +9,7 @@ my $pattrn = 'stats.t.*txt'; my $tmpdir = File::Temp->newdir; plan skip_all => "Cannot create temp directory" unless -e $tmpdir; -plan(12); +plan(15); foreach my $extend (0 .. 1) { stdout_like(sub { @@ -25,6 +25,18 @@ foreach my $extend (0 .. 1) { ); } +stdout_like(sub { + Test2::Aggregate::run_tests( + dirs => ['xt/aggregate'], + root => $root, + stats_output => '-', + pass_only => 1 + ) + }, + qr/^(?:\S*\n)+$/, + "Valid stats output for pass_only" +); + Test2::Aggregate::run_tests( dirs => ['xt/aggregate'], root => $root, From a0d4e1efe9725e6ee644de3ed1deb2b171b112eb Mon Sep 17 00:00:00 2001 From: Dimitrios Kechagias Date: Sat, 29 Jun 2024 23:03:29 +0100 Subject: [PATCH 3/7] Write stats per file when repeat==1 --- .github/workflows/ci.yml | 2 +- Changes | 5 +++ MANIFEST.SKIP | 2 + README.pod | 85 ++++++++++++++++++++++++++-------------- agg | 2 +- lib/Test2/Aggregate.pm | 62 ++++++++++++++++++++++------- t/errors.t | 6 ++- t/stats.t | 3 +- 8 files changed, 118 insertions(+), 49 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 666dba5..7efc33f 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -32,4 +32,4 @@ jobs: - run: cpanm --notest --installdeps --verbose . - run: perl Makefile.PL - run: make - - run: prove -wlvmb t \ No newline at end of file + - run: prove -wlvmb t diff --git a/Changes b/Changes index 64b4dda..ec49dce 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,10 @@ Revision history for Test2-Aggregate +0.18 2024-06-29 + agg helper script. + 'pass_only' option. + Write stats per test file (repeat==1) to avoid losing them on SIG exit. + 0.17 2022-02-10 Ignore empty lines in list files. diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index 78c67f9..2021ad2 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -7,7 +7,9 @@ MYMETA.* _build/ cover_db/ blib/ +.github/ .git/ +.gitignore/ inc/ .lwpcookies .last_cover_stats diff --git a/README.pod b/README.pod index bd1388e..236273a 100644 --- a/README.pod +++ b/README.pod @@ -15,7 +15,7 @@ Test2::Aggregate - Aggregate tests for increased speed =head1 VERSION -Version 0.17 +Version 0.18 =head1 DESCRIPTION @@ -64,6 +64,7 @@ have less issues with L (see notes). override => \%override, # optional, requires Sub::Override stats_output => $stats_output_path, # optional extend_stats => 0, # optional + pass_only => 0, # optional test_warnings => 0, # optional allow_errors => 0, # optional pre_eval => $code_to_eval, # optional @@ -219,11 +220,17 @@ the output to C, C etc). =item * C (optional) -This option exists to make the default output format of C be fixed, +This option exist to make the default output format of C be fixed, but still allow additions in future versions that will only be written with the C option enabled. Additions with C as of the current version: +=item * C (optional) + +Modifies C by making it only print out a list of passing tests. +Useful for creating lists of aggregateable tests. +Has no effect if C is not defined. + =over 4 - starting date/time in ISO_8601. @@ -315,47 +322,67 @@ disable warnings on redefines only for tests that run aggregated: Another idea is to make the test die when it is run under the aggregator, if, at design time, you know it is not supposed to run aggregated. +=head2 agg helper script + + agg [options] + +Pass a list of Perl test files/directories and they will run aggregated via yath +(or prove if specified). + + Options: + --out , -o : Specify the test file to be created (tmp file by default). + --prove, -p : Force prove (default is yath if detected). + --verbose, -v : Verbose (passed to yath/prove) + --include , -I : Library paths to include. + --test_warnings, -w : Fail tests on warnings. + --test_bundle , -t : Test bundle (default: Test2::V0). Can be comma-separated list. + --pass_list , -l : Output directory for list of 100% passing tests. + --stats_output , -s : Stats output directory (does not combine with pass_list). + --help -h : Show basic help and exit. + =head2 Example aggregating strategy There are many approaches you could do to use C with an existing -test suite, so for example you can start by making a list of the test files you -are trying to aggregate: +test suite, usually involving an iterative process of trying to run several tests +aggregated, seeing if you can fix the failing ones, otherwise you remove them from +the aggregation etc. - find t -name '*.t' > all.lst +This process can be done with the help of the C script. For example, to try +all tests under C aggregated and a list of passing tests put under the C +directory you would do: -If you have a substantial test suite, perhaps try with a portion of it (a subdir?) -instead of the entire suite. In any case, try running them aggregated like this: + > agg -p pass t - use Test2::Aggregate; - use Test2::V0; # Or Test::More; +If the run completes, you have a "starting point" - i.e. a .txt list that can run +under the aggregator with the C option: - my $stats = Test2::Aggregate::run_tests( - lists => ['all.lst'], + Test2::Aggregate::run_tests( + lists => ['pass/name_of_file.txt'] ); - open OUT, ">pass.lst"; - foreach my $test (sort {$stats->{$a}->{test_no} <=> $stats->{$b}->{test_no}} keys %$stats) { - print OUT "$test\n" if $stats->{$test}->{pass_perc}; - } - close OUT; - - done_testing(); +If the run does not complete (e.g. signal 11 on some test), try fewer tests by +choosing just a subdirectory. If that's not possible, you'll probably have to go +to the more manual method of getting a full list of your tests +(C all.lst>) then trying to run parts of it, again with +the C option. -Run the above with C or C in verbose mode, so that in case the run -hangs (it can happen), you can see where it did so and edit C removing -the offending test. - -If the run completes, you have a "starting point" - i.e. a list that can run under -the aggregator in C. -You can try adding back some of the failed tests - test failures can be cascading, -so some might be passing if added back, or have small issues you can address. +After you have a starting point, you can try see if there is an obvious reason some +tests fail and address it to add them back to the pass list. You can even try adding +back some of the failed tests that were not among the first to fail - test failures +can sometimes be cascading, so some might be passing if added back, or have small +issues you can address. Try adding C 1> to C to fix warnings as well, unless it is common for your tests to have C output. -To have your entire suite run aggregated tests together once and not repeat them -along with the other, non-aggregated, tests, it is a good idea to use the -C<--exclude-list> option of the C. +In the end, you will end up with part of your tests aggregated in (multiple if you +want to run them in parallel) list files, with the rest of your tests to be run +non-aggregated. + +You don't actually have to move and separate aggregated/non-aggregated files when +using lists, you can still have your entire suite run the aggregated tests once and +not repeat them along with the other, non-aggregated tests, by taking advantage of +the C<--exclude-list> option of the C. Hopefully your tests can run in parallel (C), in which case you would split your aggregated tests into multiple lists to have them run in parallel. diff --git a/agg b/agg index 8c9839c..80631a4 100755 --- a/agg +++ b/agg @@ -83,7 +83,7 @@ my \$stats = Test2::Aggregate::run_tests( "; $code .= "\ttest_warnings => 1,\n" if $opt{test_warnings}; $code .= "\tstats_output => '$opt{stats_output}',\n" if $opt{stats_output}; -$code .= "\tpass_only => 1,\n" if $opt{pass_only}; +$code .= "\tpass_only => 1,\n" if $opt{pass_list}; $code .= "\tdirs => [\n"; $code .= join(",\n", map {"'$_'"} normalize_paths($cwd, @ARGV)); $code .= "\n\t], diff --git a/lib/Test2/Aggregate.pm b/lib/Test2/Aggregate.pm index fc73025..d9811f7 100644 --- a/lib/Test2/Aggregate.pm +++ b/lib/Test2/Aggregate.pm @@ -244,6 +244,7 @@ Additions with C as of the current version: Modifies C by making it only print out a list of passing tests. Useful for creating lists of aggregateable tests. +Has no effect if C is not defined. =over 4 @@ -374,14 +375,15 @@ sub _process_warnings { } sub _run_tests { - my $tests = shift; - my $args = shift; + my $tests = shift; + my $args = shift; my $repeat = $args->{repeat}; $repeat = 1 if $repeat < 0; my (%stats, $start); require Time::HiRes if $args->{stats_output}; + my $fh = _stats_fh($args); for my $i (1 .. $repeat) { my $iter = $repeat > 1 ? "Iter: $i/$repeat - " : ''; @@ -416,10 +418,19 @@ sub _run_tests { if $args->{stats_output}; $stats{$test}{pass_perc} += $result ? 100/$repeat : 0; $count++; + + # If we have single iteration, no need to collect stats so write + # per line to avoid losing them in case of SIG + _print_stats($fh, \%stats, $args, $test) + if $args->{stats_output} && $repeat == 1; } } - _print_stats(\%stats, $args) if $args->{stats_output}; + if ($args->{stats_output}) { + # Write all stats for many iterations + _print_stats($fh, \%stats, $args) if $repeat > 1; + _close_stats($fh, $args); + } $args->{stats} = \%stats; } @@ -434,8 +445,10 @@ sub _override { return $override; } -sub _print_stats { - my ($stats, $args) = @_; +sub _stats_fh { + my $args = shift; + + return unless $args->{stats_output}; unless (-e $args->{stats_output}) { my @create = mkpath($args->{stats_output}); @@ -453,23 +466,41 @@ sub _print_stats { open($fh, '>', $file) or die "Can't open > $file: $!"; } - my $total = 0; + $args->{total_time} = 0; my $extra = $args->{extend_stats} ? ' TIMESTAMP' : ''; print $fh "TIME PASS%$extra TEST\n" unless $args->{pass_only}; - foreach my $test (sort {$stats->{$b}->{time}<=>$stats->{$a}->{time}} keys %$stats) { + return $fh; +} + +sub _close_stats { + my ($fh, $args) = @_; + + return unless $fh; + + printf $fh "TOTAL TIME: %.1f sec\n", $args->{total_time} + unless $args->{pass_only}; + close $fh unless $args->{stats_output} =~ /^-$/; +} + +sub _print_stats { + my ($fh, $stats, $args, $test) = @_; + + return unless $fh; + + my @tests = $test ? $test : keys %$stats; + my $extra = ''; + + foreach my $test (sort {$stats->{$b}->{time}<=>$stats->{$a}->{time}} @tests) { if ($args->{pass_only}) { print $fh "$test\n" if $stats->{$test}->{pass_perc} > 99; next; } $extra = ' '.$stats->{$test}->{timestamp} if $args->{extend_stats}; - $total += $stats->{$test}->{time}; + $args->{total_time} += $stats->{$test}->{time}; printf $fh "%.2f %d$extra $test\n", $stats->{$test}->{time}, $stats->{$test}->{pass_perc}; } - - printf $fh "TOTAL TIME: %.1f sec\n", $total unless $args->{pass_only}; - close $fh unless $args->{stats_output} =~ /^-$/; } sub _uniq { @@ -603,10 +634,11 @@ under the aggregator with the C option: lists => ['pass/name_of_file.txt'] ); -If the run does not complete, try fewer tests by choosing just a subdirectory. If -that's not possible, you'll probably have to go to the more manual method of getting -a full list of your tests (C all.lst>) then trying to run -parts of it, again with the C option. +If the run does not complete (e.g. signal 11 on some test), try fewer tests by +choosing just a subdirectory. If that's not possible, you'll probably have to go +to the more manual method of getting a full list of your tests +(C all.lst>) then trying to run parts of it, again with +the C option. After you have a starting point, you can try see if there is an obvious reason some tests fail and address it to add them back to the pass list. You can even try adding diff --git a/t/errors.t b/t/errors.t index b4ac679..f755916 100644 --- a/t/errors.t +++ b/t/errors.t @@ -16,8 +16,10 @@ is(scalar(keys %$stats), 1, 'Only 1 subtest ran'); is( intercept { Test2::Aggregate::run_tests( - dirs => ['xt/failing'], - root => $root + dirs => ['xt/failing'], + root => $root, + stats_output => '-', + pass_only => 1 ) }, array { diff --git a/t/stats.t b/t/stats.t index 951cb23..4204fb6 100644 --- a/t/stats.t +++ b/t/stats.t @@ -9,7 +9,7 @@ my $pattrn = 'stats.t.*txt'; my $tmpdir = File::Temp->newdir; plan skip_all => "Cannot create temp directory" unless -e $tmpdir; -plan(15); +plan(17); foreach my $extend (0 .. 1) { stdout_like(sub { @@ -48,6 +48,7 @@ like(find($tmpdir, $pattrn), [qr/$pattrn/], "Found stats file"); Test2::Aggregate::run_tests( dirs => ['xt/aggregate'], root => $root, + repeat => 2, stats_output => "$tmpdir/tmp1$timest" ); From 97a58f94cd03e64f63ecfb0cd338a111e4da9ffe Mon Sep 17 00:00:00 2001 From: Dimitrios Kechagias Date: Mon, 1 Jul 2024 16:23:20 +0100 Subject: [PATCH 4/7] absolute option, more agg --- Changes | 4 ++- agg | 59 ++++++++++++++++++++----------- lib/Test2/Aggregate.pm | 80 +++++++++++++++++++++++++++--------------- t/warn.t | 49 ++++++++++++++++---------- 4 files changed, 123 insertions(+), 69 deletions(-) diff --git a/Changes b/Changes index ec49dce..a769932 100644 --- a/Changes +++ b/Changes @@ -1,9 +1,11 @@ Revision history for Test2-Aggregate -0.18 2024-06-29 +0.18 2024-07-01 agg helper script. 'pass_only' option. Write stats per test file (repeat==1) to avoid losing them on SIG exit. + Test names without $root for stats, 'absolute' option for old behaviour. + 'reverse' applied after 'sort'. 0.17 2022-02-10 Ignore empty lines in list files. diff --git a/agg b/agg index 80631a4..26b0197 100755 --- a/agg +++ b/agg @@ -14,18 +14,23 @@ or to check whether specific tests can pass under Test2::Aggregate. =head1 SYNOPSIS - agg [options] + agg [options] Options: - --out , -o : Specify the test file to be created (tmp file by default). - --prove, -p : Force prove (default is yath if detected). - --verbose, -v : Verbose (passed to yath/prove) - --include , -I : Library paths to include. - --test_warnings, -w : Fail tests on warnings. - --test_bundle , -t : Test bundle (default: Test2::V0). Can be comma-separated list. - --pass_list , -l : Output directory for list of 100% passing tests. - --stats_output , -s : Stats output directory (does not combine with pass_list). - --help -h : Show basic help and exit. + --out , -o : Specify the test file to be created (tmp file by default). + --lists, -l : Use files specified as lists. + --prove, -p : Force prove (default is yath/Test2 if detected). + --verbose, -v : Verbose (passed to yath/prove) + --absolute, -a : Use absolute paths in generated files. + --include , -I : Library paths to include. + --test_warnings, -w : Fail tests on warnings. + --test_bundle , -t : Test bundle (def: Test2::V0 or Test::More if -p). Can be comma-separated list. + --pass_output , -po : Output directory for list of 100% passing tests. + --reverse : Reverse the test order. + --shuffle : Shuffle the test order. + --sort : Run the tests alphabetically. + --stats_output , -so : Stats output directory (does not combine with pass_output). + --help -h : Show basic help and exit. =cut @@ -46,9 +51,13 @@ GetOptions( 'help|h', 'include|I=s', 'out|o=s', - 'pass_list|l=s', + 'lists|l', + 'pass_output|po=s', 'prove|p', - 'stats_output|s=s', + 'reverse', + 'shuffle', + 'sort', + 'stats_output|so=s', 'test_bundle|t=s', 'test_warnings|w', 'verbose|v', @@ -57,12 +66,12 @@ GetOptions( pod2usage({-verbose => 1, -output => \*STDOUT, -noperldoc => 1}) if $opt{help} || !@ARGV; -$opt{test_bundle} ||= 'Test2::V0'; -$opt{stats_output} = $opt{pass_list} if $opt{pass_list}; +$opt{test_bundle} ||= $opt{prove} ? 'Test::More' : 'Test2::V0'; +$opt{stats_output} = $opt{pass_output} if $opt{pass_output}; unless ($opt{prove}) { - my $res = `which yath`; - $opt{prove} = 1 unless $res; + eval "use Test2::Harness"; + $opt{prove} = 1 if $@; } my $file = $opt{out} ? path($opt{out}) : Path::Tiny->tempfile( @@ -83,9 +92,14 @@ my \$stats = Test2::Aggregate::run_tests( "; $code .= "\ttest_warnings => 1,\n" if $opt{test_warnings}; $code .= "\tstats_output => '$opt{stats_output}',\n" if $opt{stats_output}; -$code .= "\tpass_only => 1,\n" if $opt{pass_list}; -$code .= "\tdirs => [\n"; -$code .= join(",\n", map {"'$_'"} normalize_paths($cwd, @ARGV)); +$code .= "\tpass_only => 1,\n" if $opt{pass_output}; +$code .= "\treverse => 1,\n" if $opt{reverse}; +$code .= "\tshuffle => 1,\n" if $opt{shuffle}; +$code .= "\tsort => 1,\n" if $opt{sort}; +$code .= "\troot => '$cwd',\n\t"; +$code .= $opt{lists} ? "lists" : "dirs"; +$code .= " => [\n"; +$code .= join(",\n", map {"'$_'"} absolute_paths($cwd, $opt{absolute}, @ARGV)); $code .= "\n\t], ); done_testing(); @@ -108,8 +122,11 @@ sub test_bundle_use { return $str; } -sub normalize_paths { - my $cwd = shift; +sub absolute_paths { + my $cwd = shift; + my $abs = shift; + return @_ unless $abs; + my @paths = @_; my @norm; diff --git a/lib/Test2/Aggregate.pm b/lib/Test2/Aggregate.pm index d9811f7..a22f981 100644 --- a/lib/Test2/Aggregate.pm +++ b/lib/Test2/Aggregate.pm @@ -80,6 +80,7 @@ have less issues with L (see notes). stats_output => $stats_output_path, # optional extend_stats => 0, # optional pass_only => 0, # optional + absolute => 0, # optional test_warnings => 0, # optional allow_errors => 0, # optional pre_eval => $code_to_eval, # optional @@ -172,6 +173,7 @@ across systems. =item * C (optional) Random order of tests if set to true. Will override C. +Uses C, so is affected by the C<$RAND> variable. =item * C (optional) @@ -246,6 +248,10 @@ Modifies C by making it only print out a list of passing tests. Useful for creating lists of aggregateable tests. Has no effect if C is not defined. +=item * C (optional) + +Matches pre-v0.18 behaviour by including C to the output of stats. + =over 4 - starting date/time in ISO_8601. @@ -266,24 +272,24 @@ sub run_tests { my $override = $args{override} ? _override($args{override}) : undef; my @dirs = (); - my $root = $args{root} || ''; + $args{root} ||= ''; my @tests; @dirs = @{$args{dirs}} if $args{dirs}; - $root .= '/' unless !$root || $root =~ m#/$#; + $args{root} .= '/' unless !$args{root} || $args{root} =~ m#/$#; - if ($root && ! -e $root) { - warn "Root '$root' does not exist, no tests are loaded." + if ($args{root} && ! -e $args{root}) { + warn "Root '$args{root}' does not exist, no tests are loaded." } else { foreach my $file (@{$args{lists}}) { push @dirs, map { /^\s*(?:#|$)/ ? () : $_ } - split( /\r?\n/, _read_file("$root$file", $args{slurp_param}) ); + split(/\r?\n/, _read_file($args{root}.$file, $args{slurp_param})); } find( sub {push @tests, $File::Find::name if /\.t$/}, - grep {-e} map {$root . $_} @dirs + grep {-e} map {$args{root} . $_} @dirs ) if @dirs; } @@ -348,7 +354,6 @@ sub _process_run_order { @$tests = grep(/$args->{include}/, @$tests) if $args->{include}; @$tests = _uniq(@$tests) if $args->{unique}; - @$tests = reverse @$tests if $args->{reverse}; if ($args->{shuffle}) { require List::Util; @@ -356,6 +361,8 @@ sub _process_run_order { } elsif ($args->{sort}) { @$tests = sort @$tests; } + + @$tests = reverse @$tests if $args->{reverse}; } sub _process_warnings { @@ -389,15 +396,16 @@ sub _run_tests { my $iter = $repeat > 1 ? "Iter: $i/$repeat - " : ''; my $count = 1; foreach my $test (@$tests) { + my $test_nm = + $args->{absolute} ? $test : _test_name($test, $args->{root}); + warn "$test_nm->Test2::Aggregate\n" if $args->{test_warnings}; - warn "$test->Test2::Aggregate\n" if $args->{test_warnings}; - - $stats{$test}{test_no} = $count unless $stats{$test}{test_no}; + $stats{$test_nm}{test_no} = $count unless $stats{$test_nm}{test_no}; $start = Time::HiRes::time() if $args->{stats_output}; - $stats{$test}{timestamp} = _timestamp(); + $stats{$test_nm}{timestamp} = _timestamp(); my $exec_error; - my $result = subtest $iter. "Running test $test" => sub { + my $result = subtest $iter. "Running test $test_nm" => sub { eval $args->{pre_eval} if $args->{pre_eval}; if ($args->{dry_run}) { @@ -414,14 +422,14 @@ sub _run_tests { warn "<-Test2::Aggregate\n" if $args->{test_warnings}; - $stats{$test}{time} += (Time::HiRes::time() - $start)/$repeat + $stats{$test_nm}{time} += (Time::HiRes::time() - $start)/$repeat if $args->{stats_output}; - $stats{$test}{pass_perc} += $result ? 100/$repeat : 0; + $stats{$test_nm}{pass_perc} += $result ? 100/$repeat : 0; $count++; # If we have single iteration, no need to collect stats so write # per line to avoid losing them in case of SIG - _print_stats($fh, \%stats, $args, $test) + _print_stats($fh, \%stats, $args, $test_nm) if $args->{stats_output} && $repeat == 1; } } @@ -434,6 +442,15 @@ sub _run_tests { $args->{stats} = \%stats; } +sub _test_name { + my $test = shift; + my $root = shift; + + $test =~ s/^\Q$root\E// if $root; + + return $test; +} + sub _override { my $replace = shift; @@ -598,21 +615,26 @@ design time, you know it is not supposed to run aggregated. =head2 agg helper script - agg [options] + agg [options] Pass a list of Perl test files/directories and they will run aggregated via yath (or prove if specified). Options: - --out , -o : Specify the test file to be created (tmp file by default). - --prove, -p : Force prove (default is yath if detected). - --verbose, -v : Verbose (passed to yath/prove) - --include , -I : Library paths to include. - --test_warnings, -w : Fail tests on warnings. - --test_bundle , -t : Test bundle (default: Test2::V0). Can be comma-separated list. - --pass_list , -l : Output directory for list of 100% passing tests. - --stats_output , -s : Stats output directory (does not combine with pass_list). - --help -h : Show basic help and exit. + --out , -o : Specify the test file to be created (tmp file by default). + --lists, -l : Use files specified as lists. + --prove, -p : Force prove (default is yath/Test2 if detected). + --verbose, -v : Verbose (passed to yath/prove) + --absolute, -a : Use absolute paths in generated files. + --include , -I : Library paths to include. + --test_warnings, -w : Fail tests on warnings. + --test_bundle , -t : Test bundle (def: Test2::V0 or Test::More if -p). Can be comma-separated list. + --pass_output , -po : Output directory for list of 100% passing tests. + --reverse : Reverse the test order. + --shuffle : Shuffle the test order. + --sort : Run the tests alphabetically. + --stats_output , -so : Stats output directory (does not combine with pass_list). + --help -h : Show basic help and exit. =head2 Example aggregating strategy @@ -625,10 +647,12 @@ This process can be done with the help of the C script. For example, to try all tests under C aggregated and a list of passing tests put under the C directory you would do: - > agg -p pass t + > agg -l pass t + +(which will use C & L, you can do C for C & L) -If the run completes, you have a "starting point" - i.e. a .txt list that can run -under the aggregator with the C option: +If the run completes, thanks to the C<-l> option you have a "starting point" + i.e. a .txt list that can run under the aggregator with the C option: Test2::Aggregate::run_tests( lists => ['pass/name_of_file.txt'] diff --git a/t/warn.t b/t/warn.t index 9ad3c91..f156149 100644 --- a/t/warn.t +++ b/t/warn.t @@ -3,15 +3,19 @@ use Test2::Aggregate; my $root = (grep {/^\.$/i} @INC) ? undef : './'; -my $run = Test2::Aggregate::run_tests( - dirs => ['xt/aggregate'], - lists => ['xt/aggregate/aggregate.lst'], - root => './', - sort => 1, - test_warnings => 1 -); +foreach my $abs (0..1) { + my $run = Test2::Aggregate::run_tests( + dirs => ['xt/aggregate'], + lists => ['xt/aggregate/aggregate.lst'], + root => './', + sort => 1, + absolute => $abs, + test_warnings => 1 + ); + + check_output($run, $abs, "No warning", './'); -check_output($run, "No warning", './'); +} like( warnings { @@ -43,17 +47,21 @@ like( local $ENV{AGGREGATE_TEST_WARN} = 1; -intercept { - $run = Test2::Aggregate::run_tests( - dirs => ['xt/aggregate'], - repeat => 2, - sort => 1, - root => $root, - test_warnings => 1 - ); -}; +my $run; +foreach my $abs (0..1) { + intercept { + $run = Test2::Aggregate::run_tests( + dirs => ['xt/aggregate'], + repeat => 2, + sort => 1, + root => $root, + absolute => $abs, + test_warnings => 1 + ); + }; -check_output($run, "including failure"); + check_output($run, $abs, "including failure"); +} eval "use Test2::Plugin::BailOnFail"; @@ -71,13 +79,14 @@ unless ($@) { match(qr#Test warning output:\n<.*check_env.t>\nAGGREGATE_TEST_WARN\nAGGREGATE_TEST_WARNx2\n#), "Got expected warning" ); - check_output($run, "including failure on repeat == -1"); + check_output($run, 0, "including failure on repeat == -1"); } done_testing; sub check_output { my $run = shift; + my $abs = shift; my $msg = shift; my $r = shift || $root || ''; my %warn = (); @@ -85,6 +94,8 @@ sub check_output { $warn{warnings} = "AGGREGATE_TEST_WARN\nAGGREGATE_TEST_WARNx2\n" if $ENV{AGGREGATE_TEST_WARN}; + $r = '' unless $abs; + is( $run, { From 4469a4db57a097acae2352fe8728d4f9c46c29a9 Mon Sep 17 00:00:00 2001 From: Dimitrios Kechagias Date: Tue, 2 Jul 2024 11:05:21 +0100 Subject: [PATCH 5/7] add root to agg --- agg | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/agg b/agg index 26b0197..6344f92 100755 --- a/agg +++ b/agg @@ -19,9 +19,10 @@ or to check whether specific tests can pass under Test2::Aggregate. Options: --out , -o : Specify the test file to be created (tmp file by default). --lists, -l : Use files specified as lists. - --prove, -p : Force prove (default is yath/Test2 if detected). + --prove, -p : Force prove (default is yath/Test2 if installed). --verbose, -v : Verbose (passed to yath/prove) - --absolute, -a : Use absolute paths in generated files. + --absolute, -a : Use absolute paths in generated files. Disabled with -r. + --root -r : Define a custom root dir (default is current dir). --include , -I : Library paths to include. --test_warnings, -w : Fail tests on warnings. --test_bundle , -t : Test bundle (def: Test2::V0 or Test::More if -p). Can be comma-separated list. @@ -39,6 +40,7 @@ use warnings; use lib 'lib'; +use Carp; use Cwd; use File::Temp 'tempfile'; use Getopt::Long; @@ -48,13 +50,15 @@ use Pod::Usage; my %opt = (framework => 'Test2::V0'); GetOptions( \%opt, + 'absolute|a', 'help|h', 'include|I=s', - 'out|o=s', 'lists|l', + 'out|o=s', 'pass_output|po=s', 'prove|p', 'reverse', + 'root|r=s', 'shuffle', 'sort', 'stats_output|so=s', @@ -69,6 +73,18 @@ pod2usage({-verbose => 1, -output => \*STDOUT, -noperldoc => 1}) $opt{test_bundle} ||= $opt{prove} ? 'Test::More' : 'Test2::V0'; $opt{stats_output} = $opt{pass_output} if $opt{pass_output}; +if ($opt{root}) { + $opt{absolute} = undef; + croak "Specified --root does not exist" unless -e $opt{root}; + my $slash = ''; + $slash = '/' unless $opt{root} =~ m#/$#; + foreach (@ARGV) { + croak "$opt{root}$slash$_ doesn't exist" unless -e "$opt{root}$slash$_"; + } +} elsif (!$opt{absolute}) { + $opt{root} = "./"; +} + unless ($opt{prove}) { eval "use Test2::Harness"; $opt{prove} = 1 if $@; @@ -82,7 +98,7 @@ my $file = $opt{out} ? path($opt{out}) : Path::Tiny->tempfile( print "Writing output to $file\n" if $opt{verbose}; -my $cwd = getcwd(); +my $cwd = $opt{root} || getcwd(); my $code = test_bundle_use($opt{test_bundle}); $code .= " From 9e53c0d8f695f7ecbd6cd02d65e3ba8d100b844b Mon Sep 17 00:00:00 2001 From: Dimitrios Kechagias Date: Fri, 5 Jul 2024 18:43:01 +0100 Subject: [PATCH 6/7] aggit, no_dot, bail_on_fail --- Changes | 5 ++- MANIFEST | 2 + Makefile.PL | 2 +- agg | 89 +++++------------------------------------- lib/Test2/Aggregate.pm | 85 ++++++++++++++++++++++++++-------------- t/dirs.t | 6 ++- t/unique.t | 1 + 7 files changed, 77 insertions(+), 113 deletions(-) diff --git a/Changes b/Changes index a769932..7977480 100644 --- a/Changes +++ b/Changes @@ -1,10 +1,13 @@ Revision history for Test2-Aggregate -0.18 2024-07-01 +0.18 2024-07-03 agg helper script. + aggit helper script. 'pass_only' option. + 'bail_on_fail' option. Write stats per test file (repeat==1) to avoid losing them on SIG exit. Test names without $root for stats, 'absolute' option for old behaviour. + Add './' to start of paths when required, 'no_dot' option for old behaviour. 'reverse' applied after 'sort'. 0.17 2022-02-10 diff --git a/MANIFEST b/MANIFEST index 81de6f1..e6f654d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,6 +1,8 @@ agg +aggit Changes lib/Test2/Aggregate.pm +lib/Test2/Aggregate/Helper.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP diff --git a/Makefile.PL b/Makefile.PL index 34dec62..55384a9 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -19,7 +19,7 @@ my %WriteMakefileArgs = ( CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => '0', }, - EXE_FILES => ["agg"], + EXE_FILES => ["agg", "aggit"], TEST_REQUIRES => { 'Test::Output' => '0', 'Test2::V0' => '0' diff --git a/agg b/agg index 6344f92..87384e6 100755 --- a/agg +++ b/agg @@ -2,15 +2,16 @@ =head1 NAME -agg - Test2::Aggregate harness wrapper +agg - Test2::Aggregate harness wrapper / helper script =head1 DESCRIPTION Pass a list of Perl test files/directories and they will run aggregated via yath -(or prove if specified). +(or prove if specified). It is not meant to be used for .t files that use Test2::Aggregate +themselves. It is useful either to speed up a test run for tests you know can be aggregated, -or to check whether specific tests can pass under Test2::Aggregate. +or to check whether specific tests can run successfully under Test2::Aggregate. =head1 SYNOPSIS @@ -40,12 +41,10 @@ use warnings; use lib 'lib'; -use Carp; -use Cwd; -use File::Temp 'tempfile'; use Getopt::Long; use Path::Tiny; use Pod::Usage; +use Test2::Aggregate::Helper; my %opt = (framework => 'Test2::V0'); GetOptions( @@ -70,27 +69,9 @@ GetOptions( pod2usage({-verbose => 1, -output => \*STDOUT, -noperldoc => 1}) if $opt{help} || !@ARGV; -$opt{test_bundle} ||= $opt{prove} ? 'Test::More' : 'Test2::V0'; -$opt{stats_output} = $opt{pass_output} if $opt{pass_output}; - -if ($opt{root}) { - $opt{absolute} = undef; - croak "Specified --root does not exist" unless -e $opt{root}; - my $slash = ''; - $slash = '/' unless $opt{root} =~ m#/$#; - foreach (@ARGV) { - croak "$opt{root}$slash$_ doesn't exist" unless -e "$opt{root}$slash$_"; - } -} elsif (!$opt{absolute}) { - $opt{root} = "./"; -} - -unless ($opt{prove}) { - eval "use Test2::Harness"; - $opt{prove} = 1 if $@; -} - -my $file = $opt{out} ? path($opt{out}) : Path::Tiny->tempfile( +Test2::Aggregate::Helper::setup_options(\%opt); + +my $file = $opt{out} ? path($opt{out}.'.t') : Path::Tiny->tempfile( TEMPLATE => "aggXXXXXX", SUFFIX => '.t', UNLINK => 0 @@ -98,57 +79,7 @@ my $file = $opt{out} ? path($opt{out}) : Path::Tiny->tempfile( print "Writing output to $file\n" if $opt{verbose}; -my $cwd = $opt{root} || getcwd(); -my $code = test_bundle_use($opt{test_bundle}); - -$code .= " -use Test2::Aggregate; - -my \$stats = Test2::Aggregate::run_tests( -"; -$code .= "\ttest_warnings => 1,\n" if $opt{test_warnings}; -$code .= "\tstats_output => '$opt{stats_output}',\n" if $opt{stats_output}; -$code .= "\tpass_only => 1,\n" if $opt{pass_output}; -$code .= "\treverse => 1,\n" if $opt{reverse}; -$code .= "\tshuffle => 1,\n" if $opt{shuffle}; -$code .= "\tsort => 1,\n" if $opt{sort}; -$code .= "\troot => '$cwd',\n\t"; -$code .= $opt{lists} ? "lists" : "dirs"; -$code .= " => [\n"; -$code .= join(",\n", map {"'$_'"} absolute_paths($cwd, $opt{absolute}, @ARGV)); -$code .= "\n\t], -); -done_testing(); -"; - +my $code = Test2::Aggregate::Helper::generate_code(\%opt, @ARGV); $file->spew_utf8($code); -my $cmd = $opt{prove} ? 'prove' : 'yath'; -my @args = ($file); -unshift @args, '-v' if $opt{verbose}; -unshift @args, "-I$opt{include}" if $opt{include}; -unshift @args, 'test' unless $opt{prove}; - -exec($cmd, @args); - -sub test_bundle_use { - my @modules = split /,/, shift; - my $str = ''; - $str .= "use $_;\n" for @modules; - return $str; -} - -sub absolute_paths { - my $cwd = shift; - my $abs = shift; - return @_ unless $abs; - - my @paths = @_; - my @norm; - - $cwd =~ s#/?$#/#; - - push @norm, (substr($_, 0, 1) eq '/' ? $_ : "$cwd$_") for @paths; - - return @norm; -} +exec(Test2::Aggregate::Helper::create_command(\%opt, $file)); diff --git a/lib/Test2/Aggregate.pm b/lib/Test2/Aggregate.pm index a22f981..3c6fbb7 100644 --- a/lib/Test2/Aggregate.pm +++ b/lib/Test2/Aggregate.pm @@ -19,7 +19,7 @@ Test2::Aggregate - Aggregate tests for increased speed use Test2::V0; # Or 'use Test::More' etc if your suite uses an other framework Test2::Aggregate::run_tests( - dirs => \@test_dirs + dirs => [@test_dirs_or_files] ); done_testing(); @@ -76,12 +76,14 @@ have less issues with L (see notes). unique => 1, # optional repeat => 1, # optional, requires Test2::Plugin::BailOnFail for < 0 slow => 0, # optional + test_warnings => 0, # optional override => \%override, # optional, requires Sub::Override stats_output => $stats_output_path, # optional extend_stats => 0, # optional pass_only => 0, # optional absolute => 0, # optional - test_warnings => 0, # optional + bail_on_fail => 0, # optional, requires Test2::Plugin::BailOnFail + no_dot => 0, # optional allow_errors => 0, # optional pre_eval => $code_to_eval, # optional dry_run => 0, # optional @@ -242,6 +244,12 @@ but still allow additions in future versions that will only be written with the C option enabled. Additions with C as of the current version: +=over 4 + +- starting date/time in ISO_8601. + +=back + =item * C (optional) Modifies C by making it only print out a list of passing tests. @@ -252,11 +260,15 @@ Has no effect if C is not defined. Matches pre-v0.18 behaviour by including C to the output of stats. -=over 4 +=item * C (optional) -- starting date/time in ISO_8601. +Current version will add a C<./> at the start of a test file if the full path does +not start with C or C<.> to avoid the C<'.' is no longer in @INC> error. +Setting C to true matches pre-v0.18 behaviour that did not do this. -=back +=item * C (optional) + +Will bail (exit) on first test failure. =back @@ -320,6 +332,7 @@ sub run_tests { } } } elsif ($args{test_warnings}) { + eval 'use Test2::Plugin::BailOnFail' if $args{bail_on_fail}; $warnings = _process_warnings( Test2::V0::warnings { _run_tests(\@tests, \%args) }, \%args @@ -330,6 +343,7 @@ sub run_tests { 'No warnings in the aggregate tests.' ); } else { + eval 'use Test2::Plugin::BailOnFail' if $args{bail_on_fail}; _run_tests(\@tests, \%args); } @@ -411,9 +425,12 @@ sub _run_tests { if ($args->{dry_run}) { Test2::V0::ok($test); } else { + my $t= $test; + $t = "./$test" + unless $args->{no_dot} || $test =~ m#^[./]#; $args->{package} - ? eval "package Test::$i" . '::' . "$count; do '$test';" - : do $test; + ? eval "package Test::$i" . '::' . "$count; do '$t';" + : do $t; $exec_error = $@; } Test2::V0::is($exec_error, '', 'Execution should not fail/warn') @@ -482,6 +499,7 @@ sub _stats_fh { my $file = $args->{stats_output}."/".$args->{caller}."-"._timestamp().".txt"; open($fh, '>', $file) or die "Can't open > $file: $!"; } + select($fh); $| = 1; select(STDOUT); $args->{total_time} = 0; my $extra = $args->{extend_stats} ? ' TIMESTAMP' : ''; @@ -530,6 +548,36 @@ sub _timestamp { return sprintf "%04d%02d%02dT%02d%02d%02d", $Y+1900, $M+1, $D, $h, $m, $s; } +=head1 HELPER SCRIPTS + +=head2 agg (Test2::Aggregate harness wrapper) + + agg [options] + +Pass a list of Perl test files/directories and they will run aggregated via yath +(or prove if specified). It is not meant to be used for .t files that use Test2::Aggregate +themselves. + +It is useful either to speed up a test run for tests you know can be aggregated, +or to check whether specific tests can run successfully under Test2::Aggregate. + + Options: + --out , -o : Specify the test file to be created (tmp file by default). + --lists, -l : Use files specified as lists. + --prove, -p : Force prove (default is yath/Test2 if installed). + --verbose, -v : Verbose (passed to yath/prove) + --absolute, -a : Use absolute paths in generated files. Disabled with -r. + --root -r : Define a custom root dir (default is current dir). + --include , -I : Library paths to include. + --test_warnings, -w : Fail tests on warnings. + --test_bundle , -t : Test bundle (def: Test2::V0 or Test::More if -p). Can be comma-separated list. + --pass_output , -po : Output directory for list of 100% passing tests. + --reverse : Reverse the test order. + --shuffle : Shuffle the test order. + --sort : Run the tests alphabetically. + --stats_output , -so : Stats output directory (does not combine with pass_output). + --help -h : Show basic help and exit. + =head1 USAGE NOTES Not all tests can be modified to run under the aggregator, it is not intended @@ -613,29 +661,6 @@ disable warnings on redefines only for tests that run aggregated: Another idea is to make the test die when it is run under the aggregator, if, at design time, you know it is not supposed to run aggregated. -=head2 agg helper script - - agg [options] - -Pass a list of Perl test files/directories and they will run aggregated via yath -(or prove if specified). - - Options: - --out , -o : Specify the test file to be created (tmp file by default). - --lists, -l : Use files specified as lists. - --prove, -p : Force prove (default is yath/Test2 if detected). - --verbose, -v : Verbose (passed to yath/prove) - --absolute, -a : Use absolute paths in generated files. - --include , -I : Library paths to include. - --test_warnings, -w : Fail tests on warnings. - --test_bundle , -t : Test bundle (def: Test2::V0 or Test::More if -p). Can be comma-separated list. - --pass_output , -po : Output directory for list of 100% passing tests. - --reverse : Reverse the test order. - --shuffle : Shuffle the test order. - --sort : Run the tests alphabetically. - --stats_output , -so : Stats output directory (does not combine with pass_list). - --help -h : Show basic help and exit. - =head2 Example aggregating strategy There are many approaches you could do to use C with an existing diff --git a/t/dirs.t b/t/dirs.t index 0361eff..bfcc9ef 100644 --- a/t/dirs.t +++ b/t/dirs.t @@ -8,8 +8,10 @@ my $root = (grep {/^\.$/i} @INC) ? undef : './'; Test2::Aggregate::run_tests(); my $stats = Test2::Aggregate::run_tests( - dirs => ['xt/aggregate'], - root => $root + dirs => ['xt/aggregate'], + no_dot => 1, + bail_on_fail => 1, + root => $root ); is(scalar(keys %$stats), 2, 'subtests'); diff --git a/t/unique.t b/t/unique.t index 511dd61..271f5f7 100644 --- a/t/unique.t +++ b/t/unique.t @@ -17,6 +17,7 @@ $run = Test2::Aggregate::run_tests( lists => ['xt/aggregate/aggregate.lst'], root => $root, unique => 0, + bail_on_fail => 1, test_warnings => 1 ); From 2e10e22b0190e6fba4a8376f0617c2391befe828 Mon Sep 17 00:00:00 2001 From: Dimitrios Kechagias Date: Tue, 16 Jul 2024 20:25:45 +0100 Subject: [PATCH 7/7] relative_root --- agg | 10 +++++----- lib/Test2/Aggregate.pm | 44 ++++++++++++++++++++++++++++++++++-------- t/dirs.t | 11 ++++++++++- t/warn.t | 9 +++++---- 4 files changed, 56 insertions(+), 18 deletions(-) diff --git a/agg b/agg index 87384e6..70cc05b 100755 --- a/agg +++ b/agg @@ -23,7 +23,7 @@ or to check whether specific tests can run successfully under Test2::Aggregate. --prove, -p : Force prove (default is yath/Test2 if installed). --verbose, -v : Verbose (passed to yath/prove) --absolute, -a : Use absolute paths in generated files. Disabled with -r. - --root -r : Define a custom root dir (default is current dir). + --root -r : Define a custom root dir. --include , -I : Library paths to include. --test_warnings, -w : Fail tests on warnings. --test_bundle , -t : Test bundle (def: Test2::V0 or Test::More if -p). Can be comma-separated list. @@ -71,15 +71,15 @@ pod2usage({-verbose => 1, -output => \*STDOUT, -noperldoc => 1}) Test2::Aggregate::Helper::setup_options(\%opt); -my $file = $opt{out} ? path($opt{out}.'.t') : Path::Tiny->tempfile( +$opt{file} = $opt{out} ? path($opt{out}.'.t') : Path::Tiny->tempfile( TEMPLATE => "aggXXXXXX", SUFFIX => '.t', UNLINK => 0 ); -print "Writing output to $file\n" if $opt{verbose}; +print "Writing output to $opt{file}\n" if $opt{verbose}; my $code = Test2::Aggregate::Helper::generate_code(\%opt, @ARGV); -$file->spew_utf8($code); +$opt{file}->spew_utf8($code); -exec(Test2::Aggregate::Helper::create_command(\%opt, $file)); +exec(Test2::Aggregate::Helper::create_command(\%opt, $opt{file})); diff --git a/lib/Test2/Aggregate.pm b/lib/Test2/Aggregate.pm index 3c6fbb7..cb2a2ef 100644 --- a/lib/Test2/Aggregate.pm +++ b/lib/Test2/Aggregate.pm @@ -3,6 +3,7 @@ package Test2::Aggregate; use strict; use warnings; +use File::Basename; use File::Find; use File::Path; use Path::Tiny; @@ -84,6 +85,7 @@ have less issues with L (see notes). absolute => 0, # optional bail_on_fail => 0, # optional, requires Test2::Plugin::BailOnFail no_dot => 0, # optional + relative_root => 0, # optional allow_errors => 0, # optional pre_eval => $code_to_eval, # optional dry_run => 0, # optional @@ -135,9 +137,14 @@ Applied after C. =item * C (optional) -If defined, must be a valid root directory that will prefix all C and -C items. You may want to set it to C<'./'> if you want dirs relative -to the current directory and the dot is not in your C<@INC>. +If defined, must be a valid root directory that will prefix all C and C +items. You may want to set it to C<'./'> if you want dirs relative to the current +directory and the dot is not in your C<@INC>. + +=item * C (optional) + +Set to true if you want your root to be relative to the caller script's directory +(based on C<$0>). It is ignored if you use an absolute root path. =item * C (optional) @@ -289,19 +296,22 @@ sub run_tests { @dirs = @{$args{dirs}} if $args{dirs}; $args{root} .= '/' unless !$args{root} || $args{root} =~ m#/$#; + $args{root} = dirname($0) . "/$args{root}" + if $args{relative_root} && $args{root} && $args{root} !~ m#^/#; if ($args{root} && ! -e $args{root}) { warn "Root '$args{root}' does not exist, no tests are loaded." } else { foreach my $file (@{$args{lists}}) { push @dirs, - map { /^\s*(?:#|$)/ ? () : $_ } - split(/\r?\n/, _read_file($args{root}.$file, $args{slurp_param})); + map {/^\s*(?:#|$)/ ? () : $_} + split(/\r?\n/, + _read_file($args{root}, $file, $args{slurp_param})); } find( sub {push @tests, $File::Find::name if /\.t$/}, - grep {-e} map {$args{root} . $_} @dirs + grep {-e} map {_check_abs_path($args{root}, $_)} @dirs ) if @dirs; } @@ -353,11 +363,21 @@ sub run_tests { return $args{stats}; } +sub _check_abs_path { + my $root = shift; + my $path = shift; + # Can't use path() below as it removes ./ which is needed for absolute option + $path = "$root$path" unless !$root || substr($path, 0, 1) eq '/'; + return $path; +} + sub _read_file { + my $root = shift; my $path = shift; my $param = shift; - my $file = path($path); - return $param ? $file->slurp_utf8 : $file->slurp($param); + my $file = path(_check_abs_path($root, $path)); + + return $param ? $file->slurp($param) : $file->slurp_utf8; } sub _process_run_order { @@ -412,6 +432,7 @@ sub _run_tests { foreach my $test (@$tests) { my $test_nm = $args->{absolute} ? $test : _test_name($test, $args->{root}); + warn "$test_nm->Test2::Aggregate\n" if $args->{test_warnings}; $stats{$test_nm}{test_no} = $count unless $stats{$test_nm}{test_no}; @@ -730,6 +751,13 @@ You would call it with something like C<--exclude-lists=t/aggregate/*.lst>, and the tests listed will be excluded (you will have them running aggregated through their own C<.t> files using L). +=head1 WINDOWS SUPPORT + +Only filesystems with the C separator are supported, simply because the author +does not expect Windows users (many test suites don't work under StrawberryPerl +etc). However, if you want Windows filesystems to be supported it should be simple +enough, so just ask. + =head1 AUTHOR Dimitrios Kechagias, C<< >> diff --git a/t/dirs.t b/t/dirs.t index bfcc9ef..b8a1add 100644 --- a/t/dirs.t +++ b/t/dirs.t @@ -1,7 +1,7 @@ use Test2::V0; use Test2::Aggregate; -plan(5); +plan(7); my $root = (grep {/^\.$/i} @INC) ? undef : './'; @@ -23,3 +23,12 @@ Test2::Aggregate::run_tests( reverse => 1, root => $root ); + +Test2::Aggregate::run_tests( + dirs => ['xt/aggregate'], + load_modules => ['Test2::V0'], + package => 1, + reverse => 1, + root => '../', + relative_root => 1 +); diff --git a/t/warn.t b/t/warn.t index f156149..38de310 100644 --- a/t/warn.t +++ b/t/warn.t @@ -37,8 +37,9 @@ like( slow => 1 ); Test2::Aggregate::run_tests( - dirs => ['xt/aggregate'], - root => '/xx/', + dirs => ['xt/aggregate'], + root => '/xx/', + relative_root => 1 ); }, [qr/Root .* does not exist/], @@ -86,7 +87,7 @@ done_testing; sub check_output { my $run = shift; - my $abs = shift; + my $abs = shift || 0; my $msg = shift; my $r = shift || $root || ''; my %warn = (); @@ -111,6 +112,6 @@ sub check_output { 'pass_perc' => 100 } }, - "Correct output - $msg" + "Correct output - abs:$abs $msg" ); }