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
1 #!./perl -w
2
3 =head1 filenames.t
4
5 Test the well-formed-ness of filenames names in the MANIFEST file. Current
6 tests 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,
15 PRN, AUX, NUL, COM1, COM2, COM3, COM4, COM5, COM6, COM7, COM8, COM9, LPT1,
16 LPT2, LPT3, LPT4, LPT5, LPT6, LPT7, LPT8, and LPT9
17
18 =item * no spaces, ( or & in filenames
19
20 =back
21
22 =cut
23
24 BEGIN {
25     chdir 't';
26     @INC = '../lib';
27 }
28
29 use strict;
30 use File::Spec;
31 use File::Basename;
32 require './test.pl';
33
34
35 my $manifest = File::Spec->catfile(File::Spec->updir(), 'MANIFEST');
36
37 open my $m, '<', $manifest or die "Can't open '$manifest': $!";
38 my @files;
39 while (<$m>) {
40     chomp;
41     my($path) = split /\t+/;
42     push @files, $path;
43
44 }
45 close $m or die $!;
46
47 plan(scalar @files);
48
49 for my $file (@files) {
50     validate_file_name($file);
51 }
52 exit 0;
53
54
55 sub validate_file_name {
56     my $path = shift;
57     my $filename = basename $path;
58
59     note("testing $path");
60
61     my @path_components = split('/',$path);
62     pop @path_components; # throw away the filename
63     for my $component (@path_components) {
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         }
72     }
73
74
75     if ($filename =~ /^\-/) {
76         fail("filename does not start with -");
77         return;
78     }
79
80     my($before, $after) = split /\./, $filename;
81     if (length $before > 39) {
82         fail("filename has 39 or fewer characters before the dot");
83         return;
84     }
85     if ($after) {
86         if (length $after > 39) {
87             fail("filename has 39 or fewer characters after the dot");
88             return;
89         }
90     }
91
92     if ($filename =~ /^(?:CON|PRN|AUX|NUL|COM[1-9]|LPT[1-9])\./i) {
93         fail("filename has a reserved name");
94         return;
95     }
96
97     if ($filename =~ /\s|\(|\&/) {
98         fail("filename has a reserved character");
99         return;
100     }
101     pass("filename ok");
102 }
103
104 # EOF