File Coverage

blib/lib/Perl/Critic/Policy/ControlStructures/ProhibitReturnInDoBlock.pm
Criterion Covered Total %
statement 40 41 97.5
branch 6 8 75.0
condition n/a
subroutine 15 16 93.7
pod 4 5 80.0
total 65 70 92.8


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