X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xt%2Fall-categories.t;fp=xt%2Fall-categories.t;h=fd63eea7a99d4c7af9ff2f94c0792084c93b3878;hb=7a0d7a93dd5fea2bb680b86d5a167c307fd9bae7;hp=0000000000000000000000000000000000000000;hpb=1931c77d270438923f75b6e2ff4913a89fc9e83e;p=p5sagit%2Fstrictures.git diff --git a/xt/all-categories.t b/xt/all-categories.t new file mode 100644 index 0000000..fd63eea --- /dev/null +++ b/xt/all-categories.t @@ -0,0 +1,33 @@ +use strict; +use warnings; + +BEGIN { $ENV{PERL_STRICTURES_EXTRA} = 0 } + +use strictures (); + +# avoid loading Test::More, since it adds warning categories + +my %known_cats; @known_cats{@strictures::WARNING_CATEGORIES} = (); +my %core_cats; @core_cats{grep $_ ne 'all', keys %warnings::Offsets} = (); +my @missing = sort grep { !exists $known_cats{$_} } keys %core_cats; +my @extra = sort grep { !exists $core_cats{$_} } keys %known_cats; + +print "1..2\n"; + +print((@missing ? 'not ' : '') . "ok 1 - strictures includes all warning categories\n"); +if (@missing) { + print STDERR "# strictures is missing categories:\n"; + print STDERR "# $_\n" + for @missing; +} + +print((@extra ? 'not ' : '') . "ok 2 - strictures includes no extra categories\n"); +if (@extra) { + print STDERR "# strictures lists extra categories:\n"; + print STDERR "# $_\n" + for @extra; +} + +if (@missing || @extra) { + exit 1; +}