X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FPerl-Critic-Policy-Dynamic-NoIndirect.git;a=blobdiff_plain;f=t%2F10-basic.t;h=53629b08447ee7bab28c2b715bf2373b35e7f204;hp=55215c40110bc19d09d86893aa21b60d45224aea;hb=HEAD;hpb=ef89faf5a36a866b83462cad90209f9cc68a7e41 diff --git a/t/10-basic.t b/t/10-basic.t index 55215c4..53629b0 100644 --- a/t/10-basic.t +++ b/t/10-basic.t @@ -5,14 +5,14 @@ use warnings; my ($tests, $reports, $subtests); BEGIN { - $tests = 25; - $reports = 42; + $tests = 28; + $reports = 43; $subtests = 3; } use Test::More tests => $tests + $subtests * $reports; -use Perl::Critic::TestUtils qw/pcritique_with_violations/; +use Perl::Critic::TestUtils qw; Perl::Critic::TestUtils::block_perlcriticrc(); @@ -26,6 +26,7 @@ sub expect { sub zap (&) { } +TEST: { local $/ = "####"; @@ -35,13 +36,24 @@ sub zap (&) { } s/^\s+//s; my ($code, $expected) = split /^-{4,}$/m, $_, 2; - my @expected = eval $expected; - - my @violations = eval { pcritique_with_violations($policy, \$code) }; + my @expected; + { + local $@; + @expected = eval $expected; + if ($@) { + diag "Compilation of expected code $id failed: $@"; + next TEST; + } + } - if ($@) { - diag "Compilation $id failed: $@"; - next; + my @violations; + { + local $@; + @violations = eval { pcritique_with_violations($policy, \$code) }; + if ($@) { + diag "Critique test $id failed: $@"; + next TEST; + } } is @violations, @expected, "right count of violations $id"; @@ -51,7 +63,7 @@ sub zap (&) { } unless ($exp) { fail "Unexpected violation for chunk $id: " . $v->description; - next; + next TEST; } my $pos = $v->location; @@ -71,6 +83,9 @@ my $x = new X; ---- [ 'new', 'X', 1, 9 ] #### +use indirect; my $x = new X; +---- +#### my $x = new X; $x = new X; ---- [ 'new', 'X', 1, 9 ], [ 'new', 'X', 1, 21 ] @@ -104,6 +119,10 @@ my $x = new new; [ 'new', 'new', 1, 9 ] #### our $obj; +use indirect; my $x = new $obj; +---- +#### +our $obj; my $x = new $obj; ---- [ 'new', '$obj', 2, 9 ] @@ -194,3 +213,7 @@ our $obj; my $x = meh { new $obj } new X; ---- [ 'meh', '{', 2, 9 ], [ 'new', '$obj', 2, 15 ], [ 'new', 'X', 2, 26 ] +#### +my $x = $invalid_global_when_strict_is_on; new X; +---- +[ 'new', 'X', 1, 44 ]