This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Refactor filenames.t to use unlike() and cmp_ok() for better diagnostics.
[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 open my $m, '<', $manifest or die "Can't open '$manifest': $!";
39 my @files;
40 while (<$m>) {
41     chomp;
42     my($path) = split /\t+/;
43
44     validate_file_name($path);
45 }
46 close $m or die $!;
47
48 sub validate_file_name {
49     my $path = shift;
50     my $filename = basename $path;
51
52     note("testing $path");
53
54     my @path_components = split('/',$path);
55     pop @path_components; # throw away the filename
56     for my $component (@path_components) {
57         unlike($component, qr/\..*?\./,
58               "no directory components containing more than one '.'")
59             or return;
60
61         cmp_ok(length $component, '<=', 32,
62                "no directory with a name over 32 characters (VOS requirement)")
63             or return;
64     }
65
66
67     unlike($filename, qr/^\-/, "filename does not start with -");
68
69     my($before, $after) = split /\./, $filename;
70     cmp_ok(length $before, '<=', 39,
71            "filename has 39 or fewer characters before the dot");
72     if ($after) {
73         cmp_ok(length $after, '<=', 39,
74                "filename has 39 or fewer characters after the dot");
75     }
76
77     unlike($filename, qr/^(?:CON|PRN|AUX|NUL|COM[1-9]|LPT[1-9])\./i,
78            "filename has a reserved name");
79
80     unlike($filename, qr/\s|\(|\&/, "filename has a reserved character");
81 }
82
83 # EOF