Remove improper use of each() in B::walksymtable and fix ext/B/t/xref.t
[perl.git] / Porting / newtests-perldelta.pl
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