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
index 67dc89a..93f9dce 100644 (file)
@@ -31,72 +31,74 @@ use File::Spec;
 use File::Basename;
 require './test.pl';
 
-plan('no_plan');
 
 my $manifest = File::Spec->catfile(File::Spec->updir(), 'MANIFEST');
 
-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/;
-my @more_dont = ('\s','\(','\&');
-
 open my $m, '<', $manifest or die "Can't open '$manifest': $!";
 my @files;
 while (<$m>) {
     chomp;
     my($path) = split /\t+/;
+    push @files, $path;
 
-    validate_file_name($path);
 }
 close $m or die $!;
 
+plan(scalar @files);
+
+for my $file (@files) {
+    validate_file_name($file);
+}
+exit 0;
+
+
 sub validate_file_name {
     my $path = shift;
     my $filename = basename $path;
 
+    note("testing $path");
 
     my @path_components = split('/',$path);
     pop @path_components; # throw away the filename
     for my $component (@path_components) {
-        if ($component =~ /\..*?\./) {
-            fail("$path has a directory component containing more than one '.'");
-            return;
-        }
-
-        if (length($component) > 32) {
-            fail("$path has a directory with a name over 32 characters. This fails on VOS");
-        }
+       if ($component =~ /\..*?\./) {
+           fail("no directory components containing more than one '.'");
+           return;
+       }
+       if (length $component > 32) {
+           fail("no directory with a name over 32 characters (VOS requirement)");
+           return;
+       }
     }
 
 
-    if ($filename =~ m/^\-/) {
-        fail("starts with -: $path");
-        return;
+    if ($filename =~ /^\-/) {
+       fail("filename does not start with -");
+       return;
     }
 
     my($before, $after) = split /\./, $filename;
     if (length $before > 39) {
-        fail("more than 39 characters before the dot: $path");
-        return;
+       fail("filename has 39 or fewer characters before the dot");
+       return;
     }
-    if ($after and (length $after > 39)) {
-        fail("more than 39 characters after the dot: $path");
-        return;
+    if ($after) {
+       if (length $after > 39) {
+           fail("filename has 39 or fewer characters after the dot");
+           return;
+       }
     }
 
-    foreach (@dont) {
-        if ($filename =~ m/^$_\./i) {
-            fail("found $_ before the dot: $path");
-            return;
-        }
+    if ($filename =~ /^(?:CON|PRN|AUX|NUL|COM[1-9]|LPT[1-9])\./i) {
+       fail("filename has a reserved name");
+       return;
     }
 
-    foreach (@more_dont) {
-        if ($filename =~ m/$_/) {
-            fail("found $_: $path");
-            return;
-        }
+    if ($filename =~ /\s|\(|\&/) {
+       fail("filename has a reserved character");
+       return;
     }
-
-    ok($filename, $path);
+    pass("filename ok");
 }
 
 # EOF