This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Refactor t/porting/filenames.t to shrink the code and the TAP generated.
[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::Basename;
31 require './test.pl';
32
33
34 my $manifest = '../MANIFEST';
35
36 open my $m, '<', $manifest or die "Can't open '$manifest': $!";
37 my @files;
38 while (<$m>) {
39     chomp;
40     my($path) = split /\t+/;
41     push @files, $path;
42
43 }
44 close $m or die $!;
45
46 plan(scalar @files);
47
48 PATHNAME: for my $pathname (@files) {
49     my @path_components = split('/',$pathname);
50     my $filename = pop @path_components;
51     for my $component (@path_components) {
52         if ($component =~ /\./) {
53             fail("$pathname has directory components containing '.'");
54             next PATHNAME;
55         }
56         if (length $component > 32) {
57             fail("$pathname has a name over 32 characters (VOS requirement)");
58             next PATHNAME;
59         }
60     }
61
62
63     if ($filename =~ /^\-/) {
64         fail("$pathname starts with -");
65             next PATHNAME;
66     }
67
68     my($before, $after) = split /\./, $filename;
69     if (length $before > 39) {
70         fail("$pathname has more than 39 characters before the dot");
71     } elsif ($after && length $after > 39) {
72         fail("$pathname has more than 39 characters after the dot");
73     } elsif ($filename =~ /^(?:CON|PRN|AUX|NUL|COM[1-9]|LPT[1-9])\./i) {
74         fail("$pathname has a reserved name");
75     } elsif ($filename =~ /\s|\(|\&/) {
76         fail("$pathname has a reserved character");
77     } else {
78         pass("$pathname ok");
79     }
80 }
81
82 # EOF