Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
FindExt.t	2.62 KB	-r--r--r--	2014-12-27 11:49
args_assert.t	1.39 KB	-r--r--r--	2014-12-27 11:49
authors.t	462 B	-r--r--r--	2014-12-27 11:49
bincompat.t	446 B	-r--r--r--	2014-12-27 11:49
checkcase.t	1.17 KB	-r--r--r--	2014-12-27 11:49
checkcfgvar.t	1.36 KB	-r--r--r--	2014-12-27 11:49
cmp_version.t	486 B	-r--r--r--	2014-12-27 11:49
copyright.t	1.88 KB	-r--r--r--	2014-12-27 11:49
corelist.t	532 B	-r--r--r--	2015-01-28 21:08
customized.dat	3.13 KB	-r--r--r--	2015-01-31 22:00
customized.t	3.02 KB	-r--r--r--	2014-12-27 11:49
diag.t	23.62 KB	-r--r--r--	2015-01-15 22:12
dual-life.t	1.63 KB	-r--r--r--	2014-12-27 11:49
exec-bit.t	1.81 KB	-r--r--r--	2014-12-27 11:49
extrefs.t	3.32 KB	-r--r--r--	2014-12-27 11:49
filenames.t	1.9 KB	-r--r--r--	2014-12-27 11:49
globvar.t	1.82 KB	-r--r--r--	2014-12-27 11:49
known_pod_issues.dat	9.81 KB	-r--r--r--	2015-01-17 16:54
maintainers.t	884 B	-r--r--r--	2014-12-27 11:49
manifest.t	3.05 KB	-r--r--r--	2014-12-27 11:49
pending-author.t	1.75 KB	-r--r--r--	2014-12-27 11:49
perlfunc.t	1.39 KB	-r--r--r--	2014-12-27 11:49
pod_rules.t	1.04 KB	-r--r--r--	2014-12-27 11:49
podcheck.t	75.45 KB	-r--r--r--	2014-12-27 12:37
readme.t	2.22 KB	-r--r--r--	2014-12-27 11:49
regen.t	2.04 KB	-r--r--r--	2014-12-27 12:37
ss_dup.t	863 B	-r--r--r--	2014-12-27 11:49
test_bootstrap.t	2.42 KB	-r--r--r--	2014-12-27 11:49
utils.t	3.3 KB	-r--r--r--	2014-12-27 11:49

Rename

#!./perl -w
#
# Check whether all files mentioned in Porting/README.pod exist in Porting and
# vice versa.

BEGIN {
    @INC = '..' if -f '../TestInit.pm';
}

use TestInit qw(T); # T is chdir to the top level
use strict;
use warnings;
require 't/test.pl';

open(my $fh, '<', 'Porting/README.pod') or die("Can't open Porting/README.pod: $!");

my @porting_files = grep { !/~\z/ } glob("Porting/*");
# It seems that dying here is nicer than having several dozen failing tests
# later.  But that assumes one will see the message from die.
die "Can't get contents of Porting/ directory.\n" unless @porting_files > 1;

my (@current_order, @sorted_order, %files_in_pod);
while(<$fh>) {
    next unless $_ =~ /^=head/;
    my @matches = $_ =~ m/F<([^>]+)>/g;
    for my $file (@matches) {
        $files_in_pod{$file} = 1;
        push @current_order, $file;
    }
}

for my $file (@porting_files) {
    $file =~ s!^Porting/!!;
    $file =~ s/\.\z// if $^O eq 'VMS';
    next if $file =~ /^perl[0-9]+delta\.pod$/;
    ok(exists($files_in_pod{$file}), "$file is mentioned in Porting/README.pod");
    delete $files_in_pod{$file};
}
for my $file (keys %files_in_pod) {
    fail("$file exists in Porting/");
}

# Check if the entries in the README are in some sort of order.
eval {
    require Unicode::Collate;
    my $Collator = Unicode::Collate->new();
    @sorted_order = $Collator->sort(@current_order);
};

if(@sorted_order) {
    ok(eq_array(\@current_order, \@sorted_order), "Files are referenced in order") or
        print_right_order();
}
else {
    note('Unicode collation did not work.  Not checking order of entries.');
}

# Frankly this is a bit much for a porting test, but it exists now.
sub print_right_order {
    my $max = 0;
    for(@current_order) {
        my $l = length $_;
        $max = $l if $l > $max;
    }
    $max = 36 if $max > 36;
    note(sprintf " N   %-${max}s %-${max}s\n", "Correct", "Current");
    for(0..$#current_order) {
        my $wrong = $sorted_order[$_] eq $current_order[$_] ? '' : 'X';
        my $line = sprintf "%2d %1s %-${max}s %-${max}s\n",
            $_, $wrong, $sorted_order[$_], $current_order[$_];
        $line =~ s{ ((?:  ){2,})}{" " . ". " x (length($1)/2)}e if $_&1;
        note($line);
    }
}

done_testing();