4 # Compare the current Perl source tree and a given tag for modules that
5 # have identical version numbers but different contents.
7 # Original by slaven@rezic.de, modified by jhi and matt.w.johnson@gmail.com
9 # Adapted from Porting/cmpVERSION.pl by Abigail
13 chdir '..' unless -d 't';
14 unshift @INC, 'lib', 'Porting';
20 use ExtUtils::MakeMaker;
23 use File::Spec::Functions qw(rel2abs abs2rel catfile catdir curdir);
28 print "1..0 # SKIP: not being run from a git checkout\n";
33 # Thanks to David Golden for this suggestion.
35 my $tag_to_compare = `git describe --abbrev=0`;
36 chomp $tag_to_compare;
39 my $null = $^O eq 'MSWin32' ? 'nul' : '/dev/null';
41 my $tag_exists = `git --no-pager tag -l $tag_to_compare 2>$null`;
45 if ($tag_exists ne $tag_to_compare) {
46 print "1..0 # SKIP: '$tag_to_compare' is not a known Git tag\n";
52 for my $m (grep $Maintainers::Modules {$_} {CPAN}, keys %Maintainers::Modules) {
53 $dual_files{$_} = 1 for Maintainers::get_module_files ($m);
57 # Files to skip from the check for one reason or another,
58 # usually because they pull in their version from some other file.
62 'lib/Config.pm', # no version number but contents will vary
63 'lib/Exporter/Heavy.pm',
66 my $skip_dirs = qr{^(?:t/lib|cpan)};
68 my @all_diffs = `git --no-pager diff --name-only $tag_to_compare`;
71 my @tmp_diffs = grep {
73 $this_dir = $1 if m/^(.*)\//;
75 (!defined($this_dir) || ($this_dir !~ $skip_dirs)) &&
78 my @module_diffs = grep {!exists $dual_files {$_}} @tmp_diffs;
79 push @module_diffs => grep { exists $dual_files {$_}} @tmp_diffs;
81 unless (@module_diffs) {
83 print "ok 1 - No difference found\n";
87 my (@output_files, @output_diffs);
89 printf "1..%d\n" => scalar @module_diffs;
93 foreach my $pm_file (@module_diffs) {
95 (my $xs_file = $pm_file) =~ s/\.pm$/.xs/;
96 my $pm_eq = compare_git_file($pm_file, $tag_to_compare);
97 next unless defined $pm_eq;
100 $xs_eq = compare_git_file($xs_file, $tag_to_compare);
101 next unless defined $xs_eq;
103 next if ($pm_eq && $xs_eq);
104 my $pm_version = eval {MM->parse_version($pm_file)};
105 my $orig_pm_content = get_file_from_git($pm_file, $tag_to_compare);
106 my $orig_pm_version = eval {MM->parse_version(\$orig_pm_content)};
107 next if ( ! defined $pm_version || ! defined $orig_pm_version );
108 next if ( $pm_version eq 'undef' || $orig_pm_version eq 'undef' ); # sigh
109 next if $pm_version ne $orig_pm_version;
110 push @diff => $pm_file unless $pm_eq;
111 push @diff => $xs_file unless $xs_eq;
115 foreach my $diff (@diff) {
116 print "# $_" for `git --no-pager diff $tag_to_compare '$diff'`;
118 printf "not ok %d - %s\n" => ++ $count, $pm_file;
121 printf "ok %d - %s\n" => ++ $count, $pm_file;
127 sub compare_git_file {
128 my ($file, $tag) = @_;
129 open(my $orig_fh, "-|", "git --no-pager show $tag:$file 2>$null");
130 return undef if eof($orig_fh);
131 my $is_eq = compare($file, $orig_fh) == 0;
136 sub get_file_from_git {
137 my ($file, $tag) = @_;
139 my $file_content = `git --no-pager show $tag:$file 2>$null`;
140 return $file_content;