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