This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
3ffc44ab20a8f4a542cfcc76a03becf96ca7c70a
[perl5.git] / 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 );
74
75 my $skip_dirs = qr{^(?:t/lib|cpan)};
76
77 my @all_diffs = `git --no-pager diff --name-only $tag_to_compare`;
78 chomp @all_diffs;
79
80 my @tmp_diffs = grep {
81     my $this_dir;
82     $this_dir = $1 if m/^(.*)\//;
83     /\.pm$/ &&
84     (!defined($this_dir) || ($this_dir !~ $skip_dirs)) &&
85     !exists $skip{$_};
86 } @all_diffs;
87 my   @module_diffs =  grep {!exists $dual_files {$_}} @tmp_diffs;
88 push @module_diffs => grep { exists $dual_files {$_}} @tmp_diffs;
89
90 unless (@module_diffs) {
91     print "1..1\n";
92     print "ok 1 - No difference found\n";
93     exit;
94 }
95
96 my (@output_files, @output_diffs);
97
98 printf "1..%d\n" => scalar @module_diffs;
99
100 my $count = 0;
101 my @diff;
102 foreach my $pm_file (@module_diffs) {
103     @diff = ();
104     (my $xs_file = $pm_file) =~ s/\.pm$/.xs/;
105     my $pm_eq = compare_git_file($pm_file, $tag_to_compare);
106     next unless defined $pm_eq;
107     my $xs_eq = 1;
108     if (-e $xs_file) {
109         $xs_eq = compare_git_file($xs_file, $tag_to_compare);
110         next unless defined $xs_eq;
111     }
112     next if ($pm_eq && $xs_eq);
113     my $pm_version = eval {MM->parse_version($pm_file)};
114     my $orig_pm_content = get_file_from_git($pm_file, $tag_to_compare);
115     my $orig_pm_version = eval {MM->parse_version(\$orig_pm_content)};
116     next if ( ! defined $pm_version || ! defined $orig_pm_version );
117     next if ( $pm_version eq 'undef' || $orig_pm_version eq 'undef' ); # sigh
118     next if $pm_version ne $orig_pm_version;
119     next if exists $skip_versions{$pm_file}
120          and grep $pm_version eq $_, @{$skip_versions{$pm_file}};
121     push @diff => $pm_file unless $pm_eq;
122     push @diff => $xs_file unless $xs_eq;
123 }
124 continue {
125     if (@diff) {
126         foreach my $diff (@diff) {
127             print "# $_" for `git --no-pager diff $tag_to_compare '$diff'`;
128         }
129         printf "not ok %d - %s\n" => ++ $count, $pm_file;
130     }
131     else {
132         printf "ok %d - %s\n" => ++ $count, $pm_file;
133     }
134 }
135
136 exit;
137
138 sub compare_git_file {
139     my ($file, $tag) = @_;
140     open(my $orig_fh, "-|", "git --no-pager show $tag:$file 2>$null");
141     return undef if eof($orig_fh);
142     my $is_eq = compare($file, $orig_fh) == 0;
143     close($orig_fh);
144     return $is_eq;
145 }
146
147 sub get_file_from_git {
148     my ($file, $tag) = @_;
149     local $/ = undef;
150     my $file_content = `git --no-pager show $tag:$file 2>$null`;
151     return $file_content;
152 }