This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add new test file 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 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     if ($filename =~ m/^\-/) {
56         fail("starts with -: $path");
57         return;
58     }
59
60     my($before, $after) = split /\./, $filename;
61     if (length $before > 39) {
62         fail("more than 39 characters before the dot: $path");
63         return;
64     }
65     if ($after and (length $after > 39)) {
66         fail("more than 39 characters after the dot: $path");
67         return;
68     }
69
70     foreach (@dont) {
71         if ($filename =~ m/^$_\./i) {
72             fail("found $_ before the dot: $path");
73             return;
74         }
75     }
76
77     foreach (@more_dont) {
78         if ($filename =~ m/$_/) {
79             fail("found $_: $path");
80             return;
81         }
82     }
83
84     ok($filename, $filename);
85 }
86
87 # EOF