This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
speed up t/porting/filenames.t
[perl5.git] / t / porting / filenames.t
CommitLineData
f52c37b4
NC
1#!./perl -w
2
3=head1 filenames.t
4
5Test the well-formed-ness of filenames names in the MANIFEST file. Current
6tests being done:
7
8=over 4
9
10=item * no more than 39 characters before the dot, and 39 after
11
12=item * no filenames starting with -
13
14=item * don't use any of these names (regardless of case) before the dot: CON,
15PRN, AUX, NUL, COM1, COM2, COM3, COM4, COM5, COM6, COM7, COM8, COM9, LPT1,
16LPT2, LPT3, LPT4, LPT5, LPT6, LPT7, LPT8, and LPT9
17
18=item * no spaces, ( or & in filenames
19
20=back
21
22=cut
23
24BEGIN {
25 chdir 't';
26 @INC = '../lib';
27}
28
29use strict;
30use File::Spec;
31use File::Basename;
32require './test.pl';
33
f52c37b4
NC
34
35my $manifest = File::Spec->catfile(File::Spec->updir(), 'MANIFEST');
36
f52c37b4
NC
37open my $m, '<', $manifest or die "Can't open '$manifest': $!";
38my @files;
39while (<$m>) {
40 chomp;
41 my($path) = split /\t+/;
c4c1a999 42 push @files, $path;
f52c37b4 43
f52c37b4
NC
44}
45close $m or die $!;
46
c4c1a999
DM
47plan(scalar @files);
48
49for my $file (@files) {
50 validate_file_name($file);
51}
52exit 0;
53
54
f52c37b4
NC
55sub validate_file_name {
56 my $path = shift;
57 my $filename = basename $path;
58
7fbcd920 59 note("testing $path");
43922be2
JV
60
61 my @path_components = split('/',$path);
62 pop @path_components; # throw away the filename
63 for my $component (@path_components) {
c4c1a999
DM
64 if ($component =~ /\..*?\./) {
65 fail("no directory components containing more than one '.'");
66 return;
67 }
68 if (length $component > 32) {
69 fail("no directory with a name over 32 characters (VOS requirement)");
70 return;
71 }
43922be2
JV
72 }
73
74
c4c1a999
DM
75 if ($filename =~ /^\-/) {
76 fail("filename does not start with -");
77 return;
78 }
f52c37b4
NC
79
80 my($before, $after) = split /\./, $filename;
c4c1a999
DM
81 if (length $before > 39) {
82 fail("filename has 39 or fewer characters before the dot");
83 return;
84 }
7fbcd920 85 if ($after) {
c4c1a999
DM
86 if (length $after > 39) {
87 fail("filename has 39 or fewer characters after the dot");
88 return;
89 }
f52c37b4
NC
90 }
91
c4c1a999
DM
92 if ($filename =~ /^(?:CON|PRN|AUX|NUL|COM[1-9]|LPT[1-9])\./i) {
93 fail("filename has a reserved name");
94 return;
95 }
f52c37b4 96
c4c1a999
DM
97 if ($filename =~ /\s|\(|\&/) {
98 fail("filename has a reserved character");
99 return;
100 }
101 pass("filename ok");
f52c37b4
NC
102}
103
104# EOF