This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Corrections to spelling and grammatical errors.
[perl5.git] / t / porting / customized.t
1 #!./perl -w
2
3 # Test that CUSTOMIZED files in Maintainers.pl have not been overwritten.
4
5 BEGIN {
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';
13     @INC = qw(lib Porting t);
14     require 'test.pl';
15 }
16
17 use strict;
18 use warnings;
19 use Digest;
20 use File::Spec;
21 use Maintainers qw[%Modules get_module_files get_module_pat];
22
23 sub 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
36 sub my_get_module_files {
37     my $m = shift;
38     return filter_customized $m => map { Maintainers::expand_glob($_) } get_module_pat($m);
39 }
40
41 my $TestCounter = 0;
42
43 my $digest_type = 'SHA-1';
44
45 my $original_dir = File::Spec->rel2abs(File::Spec->curdir);
46 my $data_dir = File::Spec->catdir('t', 'porting');
47 my $customised = File::Spec->catfile($data_dir, 'customized.dat');
48
49 my %customised;
50
51 my $regen = 0;
52
53 while (@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;
62 Unknown option '$arg'
63
64 Usage: $0 [ --regen ]\n"
65     --regen    -> Regenerate the data file for $0
66
67 EOF
68     }
69 }
70
71 my $data_fh;
72
73 if ( $regen ) {
74   open $data_fh, '>:raw', $customised or die "Can't open $customised";
75 }
76 else {
77   open $data_fh, '<:raw', $customised or die "Can't open $customised";
78   while (<$data_fh>) {
79     chomp;
80     my ($module,$file,$sha) = split ' ';
81     $customised{ $module }->{ $file } = $sha;
82   }
83   close $data_fh;
84 }
85
86 foreach my $module ( sort keys %Modules ) {
87   next unless my $files = $Modules{ $module }{CUSTOMIZED};
88   next unless @{ $files };
89   my @perl_files = my_get_module_files( $module );
90   foreach my $file ( @perl_files ) {
91     my $digest = Digest->new( $digest_type );
92     {
93       open my $fh, '<', $file or die "Can't open $file";
94       binmode $fh;
95       $digest->addfile( $fh );
96       close $fh;
97     }
98     my $id = $digest->hexdigest;
99     if ( $regen ) {
100       print $data_fh join(' ', $module, $file, $id), "\n";
101       next;
102     }
103     my $should_be = $customised{ $module }->{ $file };
104     is( $id, $should_be, "SHA for $file matches stashed SHA" );
105   }
106 }
107
108 if ( $regen ) {
109   pass( "regenerated data file" );
110   close $data_fh;
111 }
112
113 done_testing();
114
115 =pod
116
117 =head1 NAME
118
119 customized.t - Test that CUSTOMIZED files in Maintainers.pl have not been overwritten
120
121 =head1 SYNOPSIS
122
123  cd t
124  ./perl -I../lib porting/customized.t --regen
125
126 =head1 DESCRIPTION
127
128 customized.t checks that files listed in C<Maintainers.pl> that have been C<CUSTOMIZED>
129 are not accidentally overwritten by CPAN module updates.
130
131 =head1 OPTIONS
132
133 =over
134
135 =item C<--regen>
136
137 Use this command line option to regenerate the C<customized.dat> file.
138
139 =back
140
141 =cut