From: Vincent Pit <vince@profvince.com>
Date: Tue, 14 Jul 2009 18:57:27 +0000 (+0200)
Subject: Generate reports for blocks and make t/10-basic.t recognize them
X-Git-Tag: v0.04~4
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FPerl-Critic-Policy-Dynamic-NoIndirect.git;a=commitdiff_plain;h=953c765f87448964b3818e2617e8186e1545a7e1

Generate reports for blocks and make t/10-basic.t recognize them
---

diff --git a/lib/Perl/Critic/Policy/Dynamic/NoIndirect.pm b/lib/Perl/Critic/Policy/Dynamic/NoIndirect.pm
index 11b9b5c..13bd467 100644
--- a/lib/Perl/Critic/Policy/Dynamic/NoIndirect.pm
+++ b/lib/Perl/Critic/Policy/Dynamic/NoIndirect.pm
@@ -100,8 +100,9 @@ sub violates_dynamic {
 
  return map {
   my ($obj, $meth, $elt) = @$_;
+  $obj = ($obj =~ /^\s*\{/) ? "a block" : "object \"$obj\"";
   $self->violation(
-   "Indirect call of method \"$meth\" on object \"$obj\"",
+   "Indirect call of method \"$meth\" on $obj",
    "You really wanted $obj\->$meth",
    $elt,
   );
diff --git a/t/10-basic.t b/t/10-basic.t
index 68715f2..399e552 100644
--- a/t/10-basic.t
+++ b/t/10-basic.t
@@ -3,13 +3,14 @@
 use strict;
 use warnings;
 
-my ($tests, $subtests);
+my ($tests, $reports, $subtests);
 BEGIN {
  $tests    = 15;
+ $reports  = 25;
  $subtests = 3;
 }
 
-use Test::More tests => $tests + $subtests * 25;
+use Test::More tests => $tests + $subtests * $reports;
 
 use Perl::Critic::TestUtils qw/pcritique_with_violations/;
 
@@ -17,6 +18,12 @@ Perl::Critic::TestUtils::block_perlcriticrc();
 
 my $policy = 'Dynamic::NoIndirect';
 
+sub expect {
+ my ($meth, $obj) = @_;
+ $obj = ($obj =~ /^\s*\{/) ? "a block" : "object \"\Q$obj\E\"";
+ qr/^Indirect call of method \"\Q$meth\E\" on $obj/,
+}
+
 {
  local $/ = "####";
 
@@ -25,7 +32,7 @@ my $policy = 'Dynamic::NoIndirect';
  while (<DATA>) {
   s/^\s+//s;
 
-  my ($code, $expected) = split /^-+$/m, $_, 2;
+  my ($code, $expected) = split /^-{4,}$/m, $_, 2;
   my @expected = eval $expected;
 
   my @violations = eval { pcritique_with_violations($policy, \$code) };
@@ -48,9 +55,7 @@ my $policy = 'Dynamic::NoIndirect';
    my $pos = $v->location;
    my ($meth, $obj, $line, $col) = @$exp;
 
-   like $v->description,
-        qr/^Indirect call of method \"\Q$meth\E\" on object \"\Q$obj\E\"/,
-        "description $id";
+   like $v->description, expect($meth, $obj), "description $id";
    is   $pos->[0], $line, "line $id";
    is   $pos->[1], $col,  "column $id";
   }