This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
update t/porting/filenames.t to check for path components contaning two
[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 plan('no_plan');
35
36 my $manifest = File::Spec->catfile(File::Spec->updir(), 'MANIFEST');
37
38 my @dont = qw/CON PRN AUX NUL COM1 COM2 COM3 COM4 COM5 COM6 COM7 COM8 COM9 LPT1 LPT2 LPT3 LPT4 LPT5 LPT6 LPT7 LPT8 LPT9/;
39 my @more_dont = ('\s','\(','\&');
40
41 open my $m, '<', $manifest or die "Can't open '$manifest': $!";
42 my @files;
43 while (<$m>) {
44     chomp;
45     my($path) = split /\t+/;
46
47     validate_file_name($path);
48 }
49 close $m or die $!;
50
51 sub validate_file_name {
52     my $path = shift;
53     my $filename = basename $path;
54
55
56     my @path_components = split('/',$path);
57     pop @path_components; # throw away the filename
58     for my $component (@path_components) {
59         if ($component =~ /\..*?\./) {
60             fail("$path has a directory component containing more than one '.'");
61             return;
62         }
63
64         if (length($component) > 32) {
65             fail("$path has a directory with a name over 32 characters. This fails on VOS");
66         }
67     }
68
69
70     if ($filename =~ m/^\-/) {
71         fail("starts with -: $path");
72         return;
73     }
74
75     my($before, $after) = split /\./, $filename;
76     if (length $before > 39) {
77         fail("more than 39 characters before the dot: $path");
78         return;
79     }
80     if ($after and (length $after > 39)) {
81         fail("more than 39 characters after the dot: $path");
82         return;
83     }
84
85     foreach (@dont) {
86         if ($filename =~ m/^$_\./i) {
87             fail("found $_ before the dot: $path");
88             return;
89         }
90     }
91
92     foreach (@more_dont) {
93         if ($filename =~ m/$_/) {
94             fail("found $_: $path");
95             return;
96         }
97     }
98
99     ok($filename, $path);
100 }
101
102 # EOF