.tests-covering-map.pl 1.9 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667
  1. #!/usr/bin/env perl
  2. use 5.040;
  3. use warnings FATAL => 'all';
  4. use re '/aa';
  5. =head1 NAME
  6. .tests-covering-map.pl - which tests reach the files that no test loads, for
  7. tests-covering
  8. =head1 DESCRIPTION
  9. git-hooks/pre-commit asks tests-covering which tests a commit can break.
  10. tests-covering follows the Perl that each test loads, and asks this map about
  11. every other file in the diff. See "THE MAP" in L<Perl::Tests::Covering>.
  12. The map answers C<q{}>, which is C<NO_TESTS>, for the files of tCMS that
  13. C<prove -l t/> never reads:
  14. =over
  15. =item Documentation
  16. Markdown, such as F<Readme.md> and F<design.md>, POD in F<.pod> files outside
  17. F<lib/>, F<CHANGELOG> and F<LICENSE>.
  18. =item The build and the install
  19. F<Makefile.PL>, F<Installer.mk>, F<package.json> and F<package-lock.json>.
  20. C<make> and C<npm> read them, and no test does.
  21. =item The tools and the hooks
  22. The C<perltidy> and C<perlcritic> configuration and the files that it reads,
  23. F<.mailmap>, F<.gitignore>, F<.gitattributes>, this map, F<git-hooks/> and
  24. F<.github/>.
  25. =item The author tests
  26. F<xt/>, which the hooks do not run.
  27. =back
  28. Anything else, it leaves unexplained, and the hook then runs every test. A
  29. file that a test reads without loading it, such as a template or a fixture,
  30. wants a rule here that names the tests that read it.
  31. =cut
  32. # Read by the tools, by make or by people, and by no test.
  33. my %NO_TESTS = map { $_ => 1 } qw{
  34. CHANGELOG LICENSE
  35. Makefile.PL Installer.mk package.json package-lock.json
  36. .perltidyrc .perlcriticrc .perlcriticrc.compat .pod_stopwords .preferred_modules.ini .preferred_binaries.ini
  37. .mailmap .gitignore .gitattributes .tests-covering-map.pl
  38. };
  39. return sub {
  40. my ($path) = @_;
  41. return q{} if $NO_TESTS{$path};
  42. return q{} if $path =~ m{\A(?:git-hooks|[.]github|xt)/}sx;
  43. return q{} if $path =~ m{[.]md\z}sx;
  44. return q{} if $path =~ m{[.]pod\z}sx && $path !~ m{\Alib/}sx;
  45. return;
  46. };