xref: /openbsd/gnu/usr.bin/perl/t/porting/customized.t (revision cecf84d4) 
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';
13    @INC = qw(lib Porting t);
14    require 'test.pl';
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 ) {
74  open $data_fh, '>:raw', $customised or die "Can't open $customised";
75}
76else {
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
86foreach 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
107if ( $regen ) {
108  pass( "regenerated data file" );
109  close $data_fh;
110}
111
112done_testing();
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
141