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