t/porting/checkcase.t

   1 #!/usr/bin/perl
   2 # Finds the files that have the same name, case insensitively in the build tree
   3
   4 BEGIN {
   5     @INC = '..' if -f '../TestInit.pm';
   6     require './test.pl';
   7 }
   8 use TestInit qw(T); # T is chdir to the top level
   9
  10 use warnings;
  11 use strict;
  12 use File::Find;
  13
  14 my %files;
  15 my $test_count = 0;
  16
  17 find({no_chdir => 1, wanted => sub {
  18            my $name = $File::Find::name;
  19            # Assumes that the path separator is exactly one character.
  20            $name =~ s/^\..//;
  21
  22            # Special exemption for Makefile, makefile
  23            return if $name =~ m!\A(?:x2p/)?[Mm]akefile\z!;
  24
  25            if ($name eq '.git') {
  26                # Don't scan the .git directory, as its contents are outside
  27                # our control. In particular, as fetch doesn't default to
  28                # --prune, # someone pushing a branch upstream with a name
  29                # which case-conflicts with a previously deleted branch will
  30                # cause action-at-a-distance failures, because locally
  31                # .git/logs/refs/remotes will contain both.
  32                ++$File::Find::prune;
  33                return;
  34            }
  35
  36            push @{$files{lc $name}}, $name;
  37          }}, '.');
  38
  39 foreach (sort values %files) {
  40     is( @$_, 1, join(", ", @$_) ) or
  41         do{ note($_) foreach @$_; };
  42 }
  43
  44 done_testing();