File Coverage

blib/lib/Perl/Critic/Policy/ControlStructures/ProhibitReturnInDoBlock.pm
Criterion Covered Total %
statement 44 45 97.7
branch 9 12 75.0
condition 3 3 100.0
subroutine 16 17 94.1
pod 4 5 80.0
total 76 82 92.6


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::ControlStructures::ProhibitReturnInDoBlock;
2 2     2   413199 use 5.008001;
  2         14  
3 2     2   13 use strict;
  2         5  
  2         55  
4 2     2   12 use warnings;
  2         5  
  2         72  
5 2     2   459 use parent 'Perl::Critic::Policy';
  2         293  
  2         15  
6 2     2   215266 use List::Util qw(any);
  2         6  
  2         143  
7 2     2   15 use Perl::Critic::Utils qw(:severities);
  2         5  
  2         101  
8 2     2   246 use constant DESC => '"return" statement in "do" block.';
  2         7  
  2         162  
9 2     2   15 use constant EXPL => 'A "return" in "do" block causes confusing behavior.';
  2         5  
  2         818  
10              
11             our $VERSION = "0.03";
12              
13 9     9 0 1194013 sub supported_parameters { return (); }
14 5     5 1 145 sub default_severity { return $SEVERITY_HIGHEST; }
15 0     0 1 0 sub default_themes { return qw(bugs complexity); }
16 9     9 1 3789555 sub applies_to { return 'PPI::Structure::Block'; }
17              
18             sub violates {
19 20     20 1 672 my ($self, $elem, undef) = @_;
20              
21 20 100       73 return if !_is_do_block($elem);
22 6 100       188 return if _is_do_loop($elem);
23              
24 4         259 my @stmts = $elem->schildren;
25 4 50       93 return if !@stmts;
26              
27 4         12 my @violations;
28              
29 4         13 for my $stmt (@stmts) {
30 9 100       1217 push @violations, $self->violation(DESC, EXPL, $stmt) if _is_return($stmt);
31             }
32              
33 4         43 return @violations;
34             }
35              
36             sub _is_do_block {
37 20     20   60 my ($elem) = @_;
38              
39 20 50       86 return 0 if !$elem->sprevious_sibling;
40 20         709 return $elem->sprevious_sibling->content eq 'do';
41             }
42              
43             sub _is_do_loop {
44 6     6   22 my ($elem) = @_;
45 6 50       30 return 0 if !$elem->snext_sibling;
46 6   100     208 return $elem->snext_sibling->content eq 'while' || $elem->snext_sibling->content eq 'until';
47             }
48              
49             sub _is_return {
50 9     9   26 my ($stmt) = @_;
51              
52 9     21   49 return any { $_->content eq 'return' } $stmt->schildren;
  21         208  
53             }
54              
55             1;
56             __END__
57              
58             =encoding utf-8
59              
60             =head1 NAME
61              
62             Perl::Critic::Policy::ControlStructures::ProhibitReturnInDoBlock - Do not "return" in "do" block
63              
64             =head1 AFFILIATION
65            
66             This policy is a policy in the L<Perl::Critic::Policy::ControlStructures::ProhibitReturnInDoBlock> distribution.
67              
68             =head1 DESCRIPTION
69              
70             Using C<return> statement in C<do> block causes unexpected behavior. A C<return> returns from entire subroutine, not from C<do> block.
71              
72             sub foo {
73             my ($x) = @_;
74             my $y = do {
75             return 2 if $x < 10; # not ok
76             return 3 if $x < 100; # not ok
77             4;
78             };
79             return $x * $y;
80             }
81             print foo(5); # prints 2, not 10;
82              
83             If you want to do early-return, you should move the body of C<do> block to a new subroutine and call it.
84              
85             sub calc_y {
86             my ($x) = @_;
87             return 2 if $x < 10;
88             return 3 if $x < 100;
89             return 4;
90             }
91              
92             sub foo {
93             my ($x) = @_;
94             my $y = calc_y($x);
95             return $x * $y;
96             }
97             print foo(5); # prints 10
98              
99             =head1 CONFIGURATION
100            
101             This Policy is not configurable except for the standard options.
102              
103             =head1 LICENSE
104              
105             Copyright (C) utgwkk.
106              
107             This library is free software; you can redistribute it and/or modify
108             it under the same terms as Perl itself.
109              
110             =head1 AUTHOR
111              
112             utgwkk E<lt>utagawakiki@gmail.comE<gt>
113              
114             =cut
115