diff options
author | Yves Orton <demerphq@gmail.com> | 2023-02-18 11:58:20 +0100 |
---|---|---|
committer | Yves Orton <demerphq@gmail.com> | 2023-02-19 09:44:05 +0800 |
commit | 36052af0af0e8795eecbd9900189364233d49e02 (patch) | |
tree | 8c7397189857f58ee3c7b83ae72d5dcb565b116f | |
parent | 148964c324b7c34af1364c126362aef077db50af (diff) | |
download | perl-36052af0af0e8795eecbd9900189364233d49e02.tar.gz |
t/porting/regen.t - no more "whack-a-mole" subtest execution
Prior to this patch t/porting/regen.t would stop after it found a
single case where the generated file was not up to date. If there
were many files this meant that you would fix, run the test again
find out about the next one, and repeat over and over... This
kind of test whack-a-mole is very frustrating. To make things worse
the old hint when there was a failure would tell you to run make regen,
which was only true for certain of the tests that might have failed.
This patch updates this logic so we test ALL the files in one go,
and then if there were any issues we die with a report detailing
*all* of the regen commands that need to be run.
It also includes some minor cleanup and tweaks so it runs properly
when executed from the root dir of the repo.
-rw-r--r-- | t/porting/regen.t | 78 |
1 files changed, 55 insertions, 23 deletions
diff --git a/t/porting/regen.t b/t/porting/regen.t index ca1417be16..21a969da5a 100644 --- a/t/porting/regen.t +++ b/t/porting/regen.t @@ -3,7 +3,8 @@ # Verify that all files generated by perl scripts are up to date. BEGIN { - @INC = '..' if -f '../TestInit.pm'; + push @INC, '..' if -f '../TestInit.pm'; + push @INC, '.' if -f './TestInit.pm'; } use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute use strict; @@ -50,29 +51,51 @@ for my $script (keys %other_requirement) { my @files = map {@$_} sort values %skip; -open my $fh, '<', 'regen.pl' - or die "Can't open regen.pl: $!"; +# find out what regen scripts would be executed by regen.pl which +# is the script that implements `make regen`. We need to know this +# because we will run regen.pl --tap, and it will in turn +# so we don't need to execute the scripts it executes directly. +my %regen_files; +{ + open my $fh, '<', 'regen.pl' + or die "Can't open regen.pl: $!"; -while (<$fh>) { - last if /^__END__/; + while (<$fh>) { + last if /^__END__/; + } + die "Can't find __END__ in regen.pl" + if eof $fh; + while (<$fh>) { + chomp $_; + ++$regen_files{$_}; + } + close $fh + or die "Can't close regen.pl: $!"; } -die "Can't find __END__ in regen.pl" - if eof $fh; - -foreach (qw(embed_lib.pl regen_lib.pl uconfig_h.pl - regcharclass_multi_char_folds.pl - charset_translations.pl - mph.pl sorted_types.pl - ), - map {chomp $_; $_} <$fh>) { + +# This may look a bit weird but it makes sense. We build a skip hash of +# all the scripts that we want to avoid executing /explicitly/ during +# our tests. This includes the files listed in %regen_files because we +# will execute them via regen.pl instead. +foreach ( + qw( + charset_translations.pl + embed_lib.pl + mph.pl + regcharclass_multi_char_folds.pl + regen_lib.pl + sorted_types.pl + uconfig_h.pl + ), + keys %regen_files +) { ++$skip{"regen/$_"}; } -close $fh - or die "Can't close regen.pl: $!"; my @progs = grep {!$skip{$_}} <regen/*.pl>; push @progs, 'regen.pl', map {"Porting/makemeta $_"} qw(-j -y); +@progs = sort @progs; plan (tests => $tests + @files + @progs); @@ -104,13 +127,22 @@ OUTER: foreach my $file (@files) { } } -foreach (@progs) { - my $args = qq[-Ilib $_ --tap]; +my @errors; +foreach my $prog (@progs) { + my $args = qq[-Ilib $prog --tap]; note("./perl $args"); my $command = "$^X $args"; - system $command - and die <<~'HINT'; - Hint: A failure in this file can often be corrected by running: - make regen -HINT + if (system $command) { # if it exits with an error... + $command=~s/\s*--tap//; + push @errors, $prog eq "regen.pl" + ? "make regen" + : $command; + } +} +if ( @errors ) { + my $commands= join "\n", sort @errors; + die "\n\nERROR. There are generated files which are NOT up to date.\n", + "You should run the following commands to update these files:\n\n", + $commands, "\n\n", + "Once they are regenerated you should commit the changes.\n\n"; } |