t/porting/cmp_version.t

   1 #!./perl -w
   2
   3 #
   4 # Compare the current Perl source tree against the version at the most
   5 # recent tag, for modules that have identical version numbers but
   6 # different contents. Skips cpan/.
   7 #
   8 # Original by slaven@rezic.de, modified by jhi and matt.w.johnson@gmail.com
   9 #
  10 # Adapted from Porting/cmpVERSION.pl by Abigail
  11 #
  12
  13 BEGIN {
  14     chdir '..' unless -d 't';
  15     unshift @INC, 'lib', 'Porting';
  16 }
  17
  18 use strict;
  19 use warnings;
  20 use version;
  21 use ExtUtils::MakeMaker;
  22 use File::Compare;
  23 use File::Find;
  24 use File::Spec::Functions qw(rel2abs abs2rel catfile catdir curdir);
  25 use Getopt::Std;
  26 use Maintainers;
  27
  28 if (! -d '.git' ) {
  29     print "1..0 # SKIP: not being run from a git checkout\n";
  30     exit 0;
  31 }
  32
  33 #
  34 # Thanks to David Golden for this suggestion.
  35 #
  36 my $tag_to_compare = `git describe --abbrev=0`;
  37 chomp $tag_to_compare;
  38 my $source_dir = '.';
  39
  40 my $null = $^O eq 'MSWin32' ? 'nul' : '/dev/null';
  41
  42 my $tag_exists = `git --no-pager tag -l $tag_to_compare 2>$null`;
  43 chomp $tag_exists;
  44
  45
  46 if ($tag_exists ne $tag_to_compare) {
  47     print "1..0 # SKIP: '$tag_to_compare' is not a known Git tag\n";
  48     exit 0;
  49 }
  50
  51
  52 my %dual_files;
  53 for my $m (grep $Maintainers::Modules {$_} {CPAN}, keys %Maintainers::Modules) {
  54     $dual_files{$_} = 1 for Maintainers::get_module_files ($m);
  55 }
  56
  57
  58 # Files to skip from the check for one reason or another,
  59 # usually because they pull in their version from some other file.
  60 my %skip;
  61 @skip{
  62     'lib/Carp/Heavy.pm',
  63     'lib/Config.pm',            # no version number but contents will vary
  64     'lib/Exporter/Heavy.pm',
  65     'win32/FindExt.pm',
  66 } = ();
  67
  68 # Files to skip just for particular version(s),
  69 # usually due to some # mix-up
  70
  71 my %skip_versions = (
  72     # 'some/sample/file.pm' => [ '1.23', '1.24' ],
  73     'dist/threads/lib/threads.pm' => [ '1.83' ],
  74 );
  75
  76 my $skip_dirs = qr{^(?:t/lib|cpan)};
  77
  78 my @all_diffs = `git --no-pager diff --name-only $tag_to_compare`;
  79 chomp @all_diffs;
  80
  81 my @tmp_diffs = grep {
  82     my $this_dir;
  83     $this_dir = $1 if m/^(.*)\//;
  84     /\.pm$/ &&
  85     (!defined($this_dir) || ($this_dir !~ $skip_dirs)) &&
  86     !exists $skip{$_};
  87 } @all_diffs;
  88 my   @module_diffs =  grep {!exists $dual_files {$_}} @tmp_diffs;
  89 push @module_diffs => grep { exists $dual_files {$_}} @tmp_diffs;
  90
  91 unless (@module_diffs) {
  92     print "1..1\n";
  93     print "ok 1 - No difference found\n";
  94     exit;
  95 }
  96
  97 my (@output_files, @output_diffs);
  98
  99 printf "1..%d\n" => scalar @module_diffs;
 100
 101 my $count = 0;
 102 my @diff;
 103 foreach my $pm_file (@module_diffs) {
 104     @diff = ();
 105     (my $xs_file = $pm_file) =~ s/\.pm$/.xs/;
 106     my $pm_eq = compare_git_file($pm_file, $tag_to_compare);
 107     next unless defined $pm_eq;
 108     my $xs_eq = 1;
 109     if (-e $xs_file) {
 110         $xs_eq = compare_git_file($xs_file, $tag_to_compare);
 111         next unless defined $xs_eq;
 112     }
 113     next if ($pm_eq && $xs_eq);
 114     my $pm_version = eval {MM->parse_version($pm_file)};
 115     my $orig_pm_content = get_file_from_git($pm_file, $tag_to_compare);
 116     my $orig_pm_version = eval {MM->parse_version(\$orig_pm_content)};
 117     next if ( ! defined $pm_version || ! defined $orig_pm_version );
 118     next if ( $pm_version eq 'undef' || $orig_pm_version eq 'undef' ); # sigh
 119     next if $pm_version ne $orig_pm_version;
 120     next if exists $skip_versions{$pm_file}
 121          and grep $pm_version eq $_, @{$skip_versions{$pm_file}};
 122     push @diff => $pm_file unless $pm_eq;
 123     push @diff => $xs_file unless $xs_eq;
 124 }
 125 continue {
 126     if (@diff) {
 127         foreach my $diff (@diff) {
 128             print "# $_" for `git --no-pager diff $tag_to_compare '$diff'`;
 129         }
 130         printf "not ok %d - %s\n" => ++ $count, $pm_file;
 131     }
 132     else {
 133         printf "ok %d - %s\n" => ++ $count, $pm_file;
 134     }
 135 }
 136
 137 exit;
 138
 139 sub compare_git_file {
 140     my ($file, $tag) = @_;
 141     open(my $orig_fh, "-|", "git --no-pager show $tag:$file 2>$null");
 142     return undef if eof($orig_fh);
 143     my $is_eq = compare($file, $orig_fh) == 0;
 144     close($orig_fh);
 145     return $is_eq;
 146 }
 147
 148 sub get_file_from_git {
 149     my ($file, $tag) = @_;
 150     local $/ = undef;
 151     my $file_content = `git --no-pager show $tag:$file 2>$null`;
 152     return $file_content;
 153 }