This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fold Abigail's TAP generation logic back into cmpVERSION.pl
[perl5.git] / Porting / cmpVERSION.pl
CommitLineData
f1c5bace
JH
1#!/usr/bin/perl -w
2
42e700c9
MJ
3# cmpVERSION - compare the current Perl source tree and a given tag
4# for modules that have identical version numbers but different contents.
f1c5bace 5#
2fb8ff88 6# with -d option, output the diffs too
844d3843
NC
7# with -x option, exclude files from modules where blead is not upstream
8#
9# (after all, there are tools like core-cpan-diff that can already deal with
10# them)
2547c837 11#
42e700c9 12# Original by slaven@rezic.de, modified by jhi and matt.w.johnson@gmail.com.
76733a60 13# Adaptation to produce TAP by Abigail, folded back into this file by Nicholas
f1c5bace
JH
14
15use strict;
16
17use ExtUtils::MakeMaker;
18use File::Compare;
e01fd32a 19use File::Spec::Functions qw(devnull);
00ad0422 20use Getopt::Long;
2547c837 21
76733a60 22my ($diffs, $exclude_upstream, $tag_to_compare, $tap);
00ad0422 23unless (GetOptions('diffs' => \$diffs,
844d3843 24 'exclude|x' => \$exclude_upstream,
e01fd32a 25 'tag=s' => \$tag_to_compare,
76733a60 26 'tap' => \$tap,
e01fd32a 27 ) && @ARGV == 0) {
76733a60 28 die "usage: $0 [ -d -x --tag TAG --tap]";
2547c837 29}
f1c5bace 30
e01fd32a
NC
31die "$0: This does not look like a Perl directory\n"
32 unless -f "perl.h" && -d "Porting";
33die "$0: 'This is a Perl directory but does not look like Git working directory\n"
34 unless -d ".git";
42e700c9 35
2385f340 36my $null = devnull();
68d2af03 37
e01fd32a
NC
38unless (defined $tag_to_compare) {
39 # Thanks to David Golden for this suggestion.
40
41 $tag_to_compare = `git describe --abbrev=0`;
42 chomp $tag_to_compare;
43}
44
68d2af03 45my $tag_exists = `git --no-pager tag -l $tag_to_compare 2>$null`;
42e700c9
MJ
46chomp $tag_exists;
47
76733a60
NC
48unless ($tag_exists eq $tag_to_compare) {
49 die "$0: '$tag_to_compare' is not a known Git tag\n" unless $tap;
50 print "1..0 # SKIP: '$tag_to_compare' is not a known Git tag\n";
51 exit 0;
52}
f1c5bace 53
844d3843
NC
54my %upstream_files;
55if ($exclude_upstream) {
3a06b4ed
NC
56 unshift @INC, 'Porting';
57 require Maintainers;
58
844d3843
NC
59 for my $m (grep {!defined $Maintainers::Modules{$_}{UPSTREAM}
60 or $Maintainers::Modules{$_}{UPSTREAM} ne 'blead'}
61 keys %Maintainers::Modules) {
62 $upstream_files{$_} = 1 for Maintainers::get_module_files($m);
2fb8ff88
DM
63 }
64}
65
88830c88
JH
66# Files to skip from the check for one reason or another,
67# usually because they pull in their version from some other file.
68my %skip;
477acd91 69@skip{
42e700c9
MJ
70 'lib/Carp/Heavy.pm',
71 'lib/Config.pm', # no version number but contents will vary
72 'lib/Exporter/Heavy.pm',
73 'win32/FindExt.pm',
477acd91 74} = ();
76733a60
NC
75
76# Files to skip just for particular version(s),
77# usually due to some # mix-up
78
79my %skip_versions;
80if ($tap) {
81 %skip_versions
82 = (
83 # 'some/sample/file.pm' => [ '1.23', '1.24' ],
84 'dist/threads/lib/threads.pm' => [ '1.83' ],
85 );
86}
87
42e700c9
MJ
88my $skip_dirs = qr|^t/lib|;
89
90my @all_diffs = `git --no-pager diff --name-only $tag_to_compare`;
91chomp @all_diffs;
92
93my @module_diffs = grep {
94 my $this_dir;
95 $this_dir = $1 if m/^(.*)\//;
96 /\.pm$/ &&
97 (!defined($this_dir) || ($this_dir !~ $skip_dirs)) &&
515cd855 98 !exists $skip{$_} &&
844d3843 99 !exists $upstream_files{$_}
42e700c9
MJ
100} @all_diffs;
101
76733a60
NC
102unless (@module_diffs) {
103 print "1..1\nok 1 - No difference found\n" if $tap;
104 exit;
105}
106
107printf "1..%d\n" => scalar @module_diffs if $tap;
108
109my $count;
110my $diff_cmd = "git --no-pager diff $tag_to_compare ";
111my (@diff);
42e700c9 112
76733a60
NC
113foreach my $pm_file (sort @module_diffs) {
114 # --tap does diff inline, --diff does it at the end.
115 @diff = () if $tap;
42e700c9
MJ
116 (my $xs_file = $pm_file) =~ s/\.pm$/.xs/;
117 my $pm_eq = compare_git_file($pm_file, $tag_to_compare);
118 next unless defined $pm_eq;
119 my $xs_eq = 1;
120 if (-e $xs_file) {
121 $xs_eq = compare_git_file($xs_file, $tag_to_compare);
122 next unless defined $xs_eq;
123 }
124 next if ($pm_eq && $xs_eq);
125 my $pm_version = eval {MM->parse_version($pm_file)};
126 my $orig_pm_content = get_file_from_git($pm_file, $tag_to_compare);
127 my $orig_pm_version = eval {MM->parse_version(\$orig_pm_content)};
300da4a1
DG
128 next if ( ! defined $pm_version || ! defined $orig_pm_version );
129 next if ( $pm_version eq 'undef' || $orig_pm_version eq 'undef' ); # sigh
130 next if $pm_version ne $orig_pm_version;
76733a60
NC
131 next if exists $skip_versions{$pm_file}
132 and grep $pm_version eq $_, @{$skip_versions{$pm_file}};
133 push @diff, $pm_file unless $pm_eq;
134 push @diff, $xs_file unless $xs_eq;
135}
136continue {
137 if (@diff) {
138 if ($tap) {
139 foreach (@diff) {
140 print "# $_" for `$diff_cmd '$_'`;
141 }
142 printf "not ok %d - %s\n", ++$count, $pm_file;
143 } else {
144 print "$pm_file\n";
145 }
146 }
147 elsif ($tap) {
148 printf "ok %d - %s\n", ++$count, $pm_file;
149 }
42e700c9
MJ
150}
151
152sub compare_git_file {
153 my ($file, $tag) = @_;
68d2af03 154 open(my $orig_fh, "-|", "git --no-pager show $tag:$file 2>$null");
42e700c9
MJ
155 return undef if eof($orig_fh);
156 my $is_eq = compare($file, $orig_fh) == 0;
157 close($orig_fh);
158 return $is_eq;
159}
160
161sub get_file_from_git {
162 my ($file, $tag) = @_;
163 local $/ = undef;
68d2af03 164 my $file_content = `git --no-pager show $tag:$file 2>$null`;
42e700c9
MJ
165 return $file_content;
166}
167
76733a60
NC
168if ($diffs) {
169 for (sort @diff) {
170 print "\n";
171 system "$diff_cmd '$_'";
172 }
2547c837 173}