1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
#!./perl -w
# Test that CUSTOMIZED files in Maintainers.pl have not been overwritten.
BEGIN {
# This test script uses a slightly atypical invocation of the 'standard'
# core testing setup stanza.
# The existing porting tools which manage the Maintainers file all
# expect to be run from the root
# XXX that should be fixed
chdir '..' unless -d 't';
@INC = qw(lib Porting t);
require 'test.pl';
}
use strict;
use warnings;
use Digest;
use File::Spec;
use Maintainers qw[%Modules get_module_files get_module_pat];
sub filter_customized {
my ($m, @files) = @_;
return @files
unless my $customized = $Modules{$m}{CUSTOMIZED};
my ($pat) = map { qr/$_/ } join '|' => map {
ref $_ ? $_ : qr/\b\Q$_\E$/
} @{ $customized };
return grep { $_ =~ $pat } @files;
}
sub my_get_module_files {
my $m = shift;
return filter_customized $m => map { Maintainers::expand_glob($_) } get_module_pat($m);
}
my $TestCounter = 0;
my $digest_type = 'SHA-1';
my $original_dir = File::Spec->rel2abs(File::Spec->curdir);
my $data_dir = File::Spec->catdir('t', 'porting');
my $customised = File::Spec->catfile($data_dir, 'customized.dat');
my %customised;
my $regen = 0;
while (@ARGV && substr($ARGV[0], 0, 1) eq '-') {
my $arg = shift @ARGV;
$arg =~ s/^--/-/; # Treat '--' the same as a single '-'
if ($arg eq '-regen') {
$regen = 1;
}
else {
die <<EOF;
Unknown option '$arg'
Usage: $0 [ --regen ]\n"
--regen -> Regenerate the data file for $0
EOF
}
}
my $data_fh;
if ( $regen ) {
open $data_fh, '>:raw', $customised or die "Can't open $customised";
}
else {
open $data_fh, '<:raw', $customised or die "Can't open $customised";
while (<$data_fh>) {
chomp;
my ($module,$file,$sha) = split ' ';
$customised{ $module }->{ $file } = $sha;
}
close $data_fh;
}
foreach my $module ( sort keys %Modules ) {
next unless my $files = $Modules{ $module }{CUSTOMIZED};
my @perl_files = my_get_module_files( $module );
foreach my $file ( @perl_files ) {
my $digest = Digest->new( $digest_type );
{
open my $fh, '<', $file or die "Can't open $file";
binmode $fh;
$digest->addfile( $fh );
close $fh;
}
my $id = $digest->hexdigest;
if ( $regen ) {
print $data_fh join(' ', $module, $file, $id), "\n";
next;
}
my $should_be = $customised{ $module }->{ $file };
is( $id, $should_be, "SHA for $file matches stashed SHA" );
}
}
if ( $regen ) {
pass( "regenerated data file" );
close $data_fh;
}
done_testing();
=pod
=head1 NAME
customized.t - Test that CUSTOMIZED files in Maintainers.pl have not been overwritten
=head1 SYNOPSIS
cd t
./perl -I../lib porting/customized.t --regen
=head1 DESCRIPTION
customized.t checks that files listed in C<Maintainers.pl> that have been C<CUSTOMIZED>
are not accidently overwritten by CPAN module updates.
=head1 OPTIONS
=over
=item C<--regen>
Use this command line option to regenerate the C<customized.dat> file.
=back
=cut
|
