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
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   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 };
103     is( $id, $should_be, "SHA for $file matches stashed SHA" );
104   }
105 }
106
107 if ( $regen ) {
108   pass( "regenerated data file" );
109   close $data_fh;
110 }
111
112 done_testing();
113
114 =pod
115
116 =head1 NAME
117
118 customized.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
127 customized.t checks that files listed in C<Maintainers.pl> that have been C<CUSTOMIZED>
128 are not accidently overwritten by CPAN module updates.
129
130 =head1 OPTIONS
131
132 =over
133
134 =item C<--regen>
135
136 Use this command line option to regenerate the C<customized.dat> file.
137
138 =back
139
140 =cut