# Copyright (c) 2009 Martin Becker. All rights reserved.
# This package is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id: 94_diag_cover.t 36 2009-06-08 11:51:03Z demetri $
# Checking whether all error messages are covered in the DIAGNOSTICS
# pod section.
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl t/94_diag_cover.t'
use 5.006;
use strict;
use warnings;
use Test;
use lib "t/lib";
use Test::MyUtils;
use Math::Polynomial 1.000;
maintainer_only();
my $mp_file = $INC{'Math/Polynomial.pm'};
if (!defined $mp_file) {
die "could not figure out module location";
}
my $mp_text = Test::MyUtils::slurp_or_bail($mp_file);
plan tests => 5;
print "# parsing file $mp_file\n";
my %in_code = (); # croak messages as found in code
my @in_pod = (); # diagnostics items found in pod
my $msg_count = 0;
while ($mp_text =~ /\bcroak ['"]([^'"]*)['"]/g) {
++ $in_code{$1};
++ $msg_count;
}
if ($mp_text =~ /^(=head1 DIAGNOSTICS\b.*?)^=head1/ms) {
my $diag = $1;
while ($diag =~ /^=item (.*)/mg) {
my $msg = $1;
$msg =~ s/E<lt>/</g;
$msg =~ s/E<gt>/>/g;
push @in_pod, $msg;
}
}
print "# found $msg_count croak calls, ", scalar(keys %in_code), " distinct\n";
ok($msg_count);
print "# found ", scalar(@in_pod), " documented message types\n";
ok(scalar @in_pod);
my $prev = '';
my $sorted = 1;
my @patterns = ();
my $WILDCARD = quotemeta quotemeta '%s';
foreach my $msg (@in_pod) {
$sorted &&= $prev lt $msg;
$prev = $msg;
my $pat = quotemeta $msg;
$pat =~ s/$WILDCARD/'.*'/geo;
push @patterns, qr/^$pat\z/;
}
ok($sorted);
my $covered_pat = join '|', @patterns;
my $covered = 1;
foreach my $msg (sort keys %in_code) {
if ($msg !~ /$covered_pat/os) {
$covered = 0;
print "# msg not covered: $msg\n";
}
}
ok($covered);
my $hit = 1;
foreach my $i (0..$#in_pod) {
my ($msg, $pat) = ($in_pod[$i], $patterns[$i]);
if (!grep /$pat/, keys %in_code) {
print "# msg not in code: $msg\n";
$hit = 0;
}
}
ok($hit);
__END__