Commit | Line | Data |
---|---|---|
a27ed3b8 MM |
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 | ||
12e75cdb JV |
88 | print <<TAIL |
89 | ||
90 | =back | |
91 | ||
92 | TAIL |