xt/strictures.t

   1 use warnings;
   2 use strict;
   3
   4 use Test::More;
   5 use File::Find;
   6 use File::Spec;
   7 use Config;
   8 use lib 't/lib';
   9 use DBICTest;
  10
  11 unless ( DBIx::Class::Optional::Dependencies->req_ok_for ('test_strictures') ) {
  12   my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('test_strictures');
  13   $ENV{RELEASE_TESTING}
  14     ? die ("Failed to load release-testing module requirements: $missing")
  15     : plan skip_all => "Test needs: $missing"
  16 }
  17
  18 use File::Find;
  19
  20 # The rationale is - if we can load all our optdeps
  21 # that are related to lib/ - then we should be able to run
  22 # perl -c checks (via syntax_ok), and all should just work
  23 my $missing_groupdeps_present = grep
  24   { ! DBIx::Class::Optional::Dependencies->req_ok_for($_) }
  25   grep
  26     { $_ !~ /^ (?: test | rdbms | dist ) _ /x }
  27     keys %{DBIx::Class::Optional::Dependencies->req_group_list}
  28 ;
  29
  30 # don't test syntax when RT#106935 is triggered (mainly CI)
  31 # FIXME - remove when RT is resolved
  32 my $tainted_relpath = (
  33   length $ENV{PATH}
  34     and
  35   ${^TAINT}
  36     and
  37   grep
  38     { ! File::Spec->file_name_is_absolute($_) }
  39     split /\Q$Config{path_sep}/, $ENV{PATH}
  40 ) ? 1 : 0;
  41
  42 find({
  43   wanted => sub {
  44     -f $_ or return;
  45     m/\.(?: pm | pl | t )$ /ix or return;
  46
  47     return if m{^(?:
  48       maint/Makefile.PL.inc/.+                        # all the maint inc snippets are auto-strictured
  49         |
  50       t/lib/DBICTest/Util/OverrideRequire.pm          # no stictures by design (load order sensitive)
  51     )$}x;
  52
  53     my $f = $_;
  54
  55     Test::Strict::strict_ok($f);
  56     Test::Strict::warnings_ok($f);
  57
  58     Test::Strict::syntax_ok($f) if (
  59       ! $tainted_relpath
  60         and
  61       ! $missing_groupdeps_present
  62         and
  63       $f =~ /^ (?: lib  )/x
  64     );
  65   },
  66   no_chdir => 1,
  67 }, (qw(lib t examples maint)) );
  68
  69 done_testing;