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