Build all packages removed dependencies of libtest-exception-perl libtest-warn-perl...

[dh-make-perl] / dev / i386 / libperl-critic-perl / libperl-critic-perl-1.088 / t / 20_policies.t

diff --git a/dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/t/20_policies.t b/dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/t/20_policies.t
new file mode 100644 (file)
index 0000000..6d136fc
--- /dev/null
+++ b/dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/t/20_policies.t
@@ -0,0 +1,127 @@
+#!perl
+
+use 5.006001;
+use strict;
+use warnings;
+use Test::More;
+use English qw(-no_match_vars);
+
+# common P::C testing tools
+use Perl::Critic::Utils qw( :characters );
+use Perl::Critic::TestUtils qw(
+    pcritique_with_violations
+    fcritique_with_violations
+    subtests_in_tree
+);
+Perl::Critic::TestUtils::block_perlcriticrc();
+
+my $subtests = subtests_in_tree( 't' );
+
+# Check for cmdline limit on policies.  Example:
+#   perl -Ilib t/20_policies.t BuiltinFunctions::ProhibitLvalueSubstr
+# or
+#   perl -Ilib t/20_policies.t t/BuiltinFunctions/ProhibitLvalueSubstr.run
+if (@ARGV) {
+    my @policies = keys %{$subtests}; # get a list of all tests
+    # This is inefficient, but who cares...
+    for (@ARGV) {
+        next if m/::/xms;
+        if (!s{\A t[\\/](\w+)[\\/](\w+)\.run \z}{$1\::$2}xms) {
+            die 'Unknown argument ' . $_;
+        }
+    }
+    for my $p (@policies) {
+        if (0 == grep {$_ eq $p} @ARGV) {
+            delete $subtests->{$p};
+        }
+    }
+}
+
+# count how many tests there will be
+my $nsubtests = 0;
+for my $s (values %$subtests) {
+    $nsubtests += @$s; # one [pf]critique() test per subtest
+}
+my $npolicies = scalar keys %$subtests; # one can() test per policy
+
+plan tests => $nsubtests + $npolicies;
+
+for my $policy ( sort keys %$subtests ) {
+    can_ok( "Perl::Critic::Policy::$policy", 'violates' );
+    for my $subtest ( @{$subtests->{$policy}} ) {
+        local $TODO = $subtest->{TODO}; # Is NOT a TODO if it's not set
+
+        my $desc =
+            join ' - ', $policy, "line $subtest->{lineno}", $subtest->{name};
+
+        my @violations = $subtest->{filename}
+            ? eval {
+                fcritique_with_violations(
+                    $policy,
+                    \$subtest->{code},
+                    $subtest->{filename},
+                    $subtest->{parms},
+                )
+            }
+            : eval {
+                pcritique_with_violations(
+                    $policy,
+                    \$subtest->{code},
+                    $subtest->{parms},
+                )
+            };
+        my $err = $EVAL_ERROR;
+
+        my $test_passed;
+        if ($subtest->{error}) {
+            if ( 'Regexp' eq ref $subtest->{error} ) {
+                $test_passed = like($err, $subtest->{error}, $desc);
+            }
+            else {
+                $test_passed = ok($err, $desc);
+            }
+        }
+        elsif ($err) {
+            if ($err =~ m/\A Unable [ ] to [ ] create [ ] policy [ ] [']/xms) {
+                # We most likely hit a configuration that a parameter didn't like.
+                fail($desc);
+                diag($err);
+                $test_passed = 0;
+            }
+            else {
+                die $err;
+            }
+        }
+        else {
+            my $expected_failures = $subtest->{failures};
+
+            # If any optional modules are NOT installed, then there should be no failures.
+            if ($subtest->{optional_modules}) {
+              MODULE:
+                for my $module (split m/,\s*/xms, $subtest->{optional_modules}) {
+                    eval "require $module";
+                    if ($EVAL_ERROR) {
+                        $expected_failures = 0;
+                        last MODULE;
+                    }
+                }
+            }
+
+            $test_passed = is(scalar @violations, $expected_failures, $desc);
+        }
+
+        if (not $test_passed) {
+            diag("Violation found: $_") foreach @violations;
+        }
+    }
+}
+
+#-----------------------------------------------------------------------------
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 78
+#   indent-tabs-mode: nil
+#   c-indentation-style: bsd
+# End:
+# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :