| 1 | #!perl -w |
| 2 | use 5.010; |
| 3 | use strict; |
| 4 | use Getopt::Long; |
| 5 | use Pod::Usage; |
| 6 | use Module::CoreList; |
| 7 | GetOptions( |
| 8 | 'spec|s:s' => \my $manifest, |
| 9 | ) or pod2usage(); |
| 10 | |
| 11 | =head1 SYNOPSIS |
| 12 | |
| 13 | newtests-perldelta.pl [FROM TO] |
| 14 | |
| 15 | Output the added tests between the two last released versions of Perl |
| 16 | |
| 17 | newtests-perldelta.pl |
| 18 | |
| 19 | Output the added tests between the version tagged v5.11.1 |
| 20 | and this version |
| 21 | |
| 22 | newtests-perldelta.pl v5.11.1 HEAD |
| 23 | |
| 24 | =cut |
| 25 | |
| 26 | my $corelist = \%Module::CoreList::version; |
| 27 | my @versions = sort keys %$corelist; |
| 28 | |
| 29 | # by default, compare latest two version in CoreList; |
| 30 | my ($from, $to) = @ARGV; |
| 31 | |
| 32 | # Convert the numbers to git version tags |
| 33 | sub num2git { |
| 34 | my ($num) = @_; |
| 35 | $num =~ /^(5)\.(\d\d\d)(\d\d\d)/ |
| 36 | or die "Couldn't make sense of version number '$num'"; |
| 37 | sprintf 'v%d.%d.%d', $1,$2,$3; |
| 38 | }; |
| 39 | |
| 40 | $from //= num2git($versions[-2]); # / |
| 41 | $to //= num2git($versions[-1]); # / |
| 42 | $manifest //= 'MANIFEST'; # / |
| 43 | |
| 44 | warn "Finding newly added tests between $from..$to\n"; |
| 45 | |
| 46 | my @new_tests = |
| 47 | grep { m!^[-+](?:t|ext)/.*\.t\s+! } # only added/removed tests |
| 48 | `git diff $from..$to -- $manifest`; |
| 49 | chomp @new_tests; |
| 50 | if (! @new_tests) { |
| 51 | die "No new tests found between $from and $to."; |
| 52 | }; |
| 53 | |
| 54 | # Now remove those files whose lines were just shuffled around |
| 55 | # within MANIFEST |
| 56 | my %desc; |
| 57 | my %removed; |
| 58 | for (@new_tests) { |
| 59 | die "Weird diff line '$_' " unless /^([+-])(\S+\.t)(?:\s+(.*))?$/; |
| 60 | my ($mod,$file,$desc) = ($1,$2,$3); |
| 61 | $desc //= '<no description>'; # / to placate Padre highlighting |
| 62 | if ($mod eq '-') { |
| 63 | $removed{ $file } = $file; |
| 64 | }; |
| 65 | $desc{ $file } = $desc; |
| 66 | }; |
| 67 | |
| 68 | print <<HEAD; |
| 69 | |
| 70 | =head1 New Tests |
| 71 | |
| 72 | Many modules updated from CPAN incorporate new tests. |
| 73 | |
| 74 | =over 4 |
| 75 | |
| 76 | HEAD |
| 77 | |
| 78 | for my $file (sort keys %desc) { |
| 79 | next if $removed{ $file }; |
| 80 | print <<ITEM; |
| 81 | =item $file |
| 82 | |
| 83 | $desc{ $file } |
| 84 | |
| 85 | ITEM |
| 86 | }; |
| 87 | |
| 88 | print <<TAIL |
| 89 | |
| 90 | =back |
| 91 | |
| 92 | TAIL |