1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
|
#!/usr/bin/perl
use Test::More;
use strict;
use warnings;
no warnings 'syntax';
unless ($ENV {AUTHOR_TESTING}) {
plan skip_all => "AUTHOR tests";
exit;
}
sub version;
#
# For a minute or two, I considered using File::Find.
#
# Henry Spencer was right:
#
# "Those who don't understand Unix are condemned to reinvent it, poorly."
#
undef $ENV {PATH};
my $FIND = "/usr/bin/find";
my $top = -d "blib" ? "blib/lib" : "lib";
my @files = `$FIND $top -name [a-zA-Z_]*.pm`;
chomp @files;
my $main_version = version "$top/Test/Regexp.pm";
unless ($main_version) {
fail "Cannot find a version in main file";
done_testing;
exit;
}
pass "Got a VERSION declaration in main file";
foreach my $file (@files, "README") {
my $base = $file;
$base =~ s!^.*/!!;
#
# Grab version
#
my $version = version $file;
unless ($version) {
fail "Did not find a version in $base; skipping tests";
next;
}
pass "Found version $version in $base";
if ($file eq 'README') {
is $version, $main_version, "Version in README matches package version"
}
else {
ok $version le $main_version,
" It does not exceed package version";
}
}
my %monthmap = qw [Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06
Jul 07 Aug 08 Sep 09 Oct 10 Nov 11 Dec 12];
if (open my $fh, "<", "Changes") {
my $first = <$fh>;
if ($first =~
/^Version ([0-9]{10}) \S+ (\S+) +([0-9]{0,2}) \S+ \S+ ([0-9]{4})/) {
my ($version, $month, $date, $year) = ($1, $2, $3, $4);
pass "Version line in Changes file formatted ok";
my $target = sprintf "%04d%02d%02d" => $year, $monthmap {$month}, $date;
is substr ($version, 0, 8), $target => " Version and date match";
is $version, $main_version => " Version matches package version";
}
else {
SKIP: {
fail "First line of Changes files correctly formatted: $first";
skip "Cannot extract a correctly formatted version", 2;
}}
}
else {
SKIP: {
fail "Failed to open Changes file: $!";
skip "Cannot open Changes file", 2;
}}
done_testing;
sub version {
my $file = shift;
open my $fh, "<", $file or return;
while (<$fh>) {
return $1 if /^our \$VERSION = '([0-9]{10})';$/;
return $1 if /This is version ([0-9]{10}) /; # README
return if / \$VERSION \s* =/x;
}
return;
}
__END__
|