xref: /openbsd/gnu/usr.bin/perl/t/porting/customized.t (revision d89ec533) 
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    skip_all("pre-computed SHA1 won't match under EBCDIC") if $::IS_EBCDIC;
16    skip_all("This distro may have modified some files in cpan/. Skipping validation.") if $ENV{'PERL_BUILD_PACKAGING'};
17}
18
19use strict;
20use warnings;
21use Digest;
22use File::Spec;
23use Maintainers qw[%Modules get_module_files get_module_pat];
24
25sub filter_customized {
26    my ($m, @files) = @_;
27
28    return @files
29        unless my $customized = $Modules{$m}{CUSTOMIZED};
30
31    my ($pat) = map { qr/$_/ } join '|' => map {
32        ref $_ ? $_ : qr/\b\Q$_\E$/
33    } @{ $customized };
34
35    return grep { $_ =~ $pat } @files;
36}
37
38sub my_get_module_files {
39    my $m = shift;
40    return filter_customized $m => map { Maintainers::expand_glob($_) } get_module_pat($m);
41}
42
43my $TestCounter = 0;
44
45my $digest_type = 'SHA-1';
46
47my $original_dir = File::Spec->rel2abs(File::Spec->curdir);
48my $data_dir = File::Spec->catdir('t', 'porting');
49my $customised = File::Spec->catfile($data_dir, 'customized.dat');
50
51my %customised;
52
53my $regen = 0;
54
55while (@ARGV && substr($ARGV[0], 0, 1) eq '-') {
56    my $arg = shift @ARGV;
57
58    $arg =~ s/^--/-/; # Treat '--' the same as a single '-'
59    if ($arg eq '-regen') {
60        $regen = 1;
61    }
62    else {
63        die <<EOF;
64Unknown option '$arg'
65
66Usage: $0 [ --regen ]\n"
67    --regen    -> Regenerate the data file for $0
68
69EOF
70    }
71}
72
73my $data_fh;
74
75if ( $regen ) {
76  open $data_fh, '>:raw', $customised or die "Can't open $customised";
77  print $data_fh <<'#';
78# Regenerate this file using:
79#     cd t
80#     ./perl -I../lib porting/customized.t --regen
81#
82}
83else {
84  open $data_fh, '<:raw', $customised or die "Can't open $customised";
85  while (<$data_fh>) {
86    next if /^#/;
87    chomp;
88    my ($module,$file,$sha) = split ' ';
89    $customised{ $module }->{ $file } = $sha;
90  }
91  close $data_fh;
92}
93
94foreach my $module ( sort keys %Modules ) {
95  next unless my $files = $Modules{ $module }{CUSTOMIZED};
96  next unless @{ $files };
97  my @perl_files = my_get_module_files( $module );
98  foreach my $file ( @perl_files ) {
99    my $digest = Digest->new( $digest_type );
100    {
101      open my $fh, '<', $file or die "Can't open $file";
102      binmode $fh;
103      $digest->addfile( $fh );
104      close $fh;
105    }
106    my $id = $digest->hexdigest;
107    if ( $regen ) {
108      print $data_fh join(' ', $module, $file, $id), "\n";
109      next;
110    }
111    my $should_be = $customised{ $module }->{ $file };
112    is( $id, $should_be, "SHA for $file matches stashed SHA" );
113  }
114}
115
116if ( $regen ) {
117  pass( "regenerated data file" );
118  close $data_fh;
119}
120
121done_testing();
122
123=pod
124
125=head1 NAME
126
127customized.t - Test that CUSTOMIZED files in Maintainers.pl have not been overwritten
128
129=head1 SYNOPSIS
130
131 cd t
132 ./perl -I../lib porting/customized.t --regen
133
134=head1 DESCRIPTION
135
136customized.t checks that files listed in C<Maintainers.pl> that have been C<CUSTOMIZED>
137are not accidentally overwritten by CPAN module updates.
138
139=head1 OPTIONS
140
141=over
142
143=item C<--regen>
144
145Use this command line option to regenerate the C<customized.dat> file.
146
147=back
148
149=cut
150