Added Ornate double-bladed sword detection

lancew · Jul 27, 2016 · 9e000e3 · 9e000e3
1 parent 320f6e0
commit 9e000e3
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 3 deletions.
diff --git a/lib/Perl/Critic/Policy/Perlsecret.pm b/lib/Perl/Critic/Policy/Perlsecret.pm
@@ -53,7 +53,7 @@ sub violates {
         'Goatse'                      => \&_goatse,
         'Flaming X-Wing'              => \&_flaming_x_wing,
         'Kite'                        => \&_kite,
-#        'Ornate Double Edged Sword'   => qr/<<m=~m>>/,
+        'Ornate Double Edged Sword'   => \&_ornate_double_edged_sword,
 #        'Flathead'                    => qr/-=!!|-=!/,
 #        'Phillips'                    => qr/\+=!!|\+=!/,
 #        'Torx'                        => qr/\*=!!|\*=!/,
@@ -163,4 +163,13 @@ sub _kite {
     }
 }
 
+sub _ornate_double_edged_sword {
+    for my $child ($_[0]->children)
+    {
+        next unless $child eq '<<m';
+        return 1 if $child->snext_sibling eq '=~'
+                 && $child->snext_sibling->snext_sibling eq 'm>>';
+    }
+}
+
 1;
diff --git a/t/20-policies.t b/t/20-policies.t
@@ -87,15 +87,19 @@ $code = <<'__CODE__';
 __CODE__
 is pcritique( 'Perlsecret', \$code ), 1, '1 x Kite';
 
-=pod
 # Ornate double-bladed sword
 $code = <<'__CODE__';
 <<m=~m>>
+
+<<m=~m>>
+The above should not be detected
+
 m
 ;
 __CODE__
-is pcritique( 'Perlsecret', \$code ), 1;
+is pcritique( 'Perlsecret', \$code ), 1, '1 x Ornate double-bladed sword';
 
+=pod
 # Flathead.
 $code = <<'__CODE__';
 $x -=!! $y