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