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   401666 use 5.008001;
  2         15  
3 2     2   12 use strict;
  2         5  
  2         54  
4 2     2   12 use warnings;
  2         6  
  2         72  
5 2     2   518 use parent 'Perl::Critic::Policy';
  2         343  
  2         17  
6 2     2   215449 use List::Util qw(any);
  2         8  
  2         150  
7 2     2   14 use Perl::Critic::Utils qw(:severities);
  2         5  
  2         117  
8 2     2   591 use constant DESC => '"return" statement in "do" block.';
  2         6  
  2         161  
9 2     2   13 use constant EXPL => 'A "return" in "do" block causes confusing behavior.';
  2         7  
  2         795  
10              
11             our $VERSION = "0.02";
12              
13 9     9 0 1176308 sub supported_parameters { return (); }
14 5     5 1 108 sub default_severity { return $SEVERITY_HIGHEST; }
15 0     0 1 0 sub default_themes { return qw(core bugs); }
16 9     9 1 3725829 sub applies_to { return 'PPI::Structure::Block'; }
17              
18             sub violates {
19 20     20 1 619 my ($self, $elem, undef) = @_;
20              
21 20 100       69 return if !_is_do_block($elem);
22 6 100       171 return if _is_do_loop($elem);
23              
24 4         250 my @stmts = $elem->schildren;
25 4 50       86 return if !@stmts;
26              
27 4         11 my @violations;
28              
29 4         12 for my $stmt (@stmts) {
30 9 100       1257 push @violations, $self->violation(DESC, EXPL, $stmt) if _is_return($stmt);
31             }
32              
33 4         37 return @violations;
34             }
35              
36             sub _is_do_block {
37 20     20   59 my ($elem) = @_;
38              
39 20 50       82 return 0 if !$elem->sprevious_sibling;
40 20         696 return $elem->sprevious_sibling->content eq 'do';
41             }
42              
43             sub _is_do_loop {
44 6     6   21 my ($elem) = @_;
45 6 50       33 return 0 if !$elem->snext_sibling;
46 6   100     189 return $elem->snext_sibling->content eq 'while' || $elem->snext_sibling->content eq 'until';
47             }
48              
49             sub _is_return {
50 9     9   23 my ($stmt) = @_;
51              
52 9     21   51 return any { $_->content eq 'return' } $stmt->schildren;
  21         207  
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