in reply to Go to perl::critic

Is there such a policy?

Here's one :-)

package Perl::Critic::Policy::ControlStructures::ProhibitGotoLabel;
use warnings;
use strict;
use base 'Perl::Critic::Policy';
use Perl::Critic::Utils qw/:severities/;

# to locate the path where to place this file, do e.g.: 
# $ perl -MFile::Basename=dirname -MPerl::Critic::Policy::ControlStruc
+tures::ProhibitUnreachableCode -le 'print dirname $INC{"Perl/Critic/P
+olicy/ControlStructures/ProhibitUnreachableCode.pm"}'
# or
# $ dirname `perldoc -l Perl::Critic::Policy::ControlStructures::Prohi
+bitUnreachableCode`

our $VERSION = '0.001';
sub supported_parameters { return }
sub default_severity { return $SEVERITY_MEDIUM }
sub default_themes { return qw/core bugs/ }
sub applies_to { return 'PPI::Token::Word' }

=head1 DESCRIPTION

A C<goto LABEL> is considered a bad practice by a number of people,
as it can lead to hard-to-understand and brittle spaghetti code.
Instead of a C<goto>, use different control structures, or place a
label on a block (such as a loop's block) and use C<next LABEL>,
C<last LABEL>, or C<redo LABEL> instead.

C<goto &NAME> is very different from C<goto LABEL> and is not covered
by this policy. C<goto EXPR> is ambiguous and this policy will report
such cases when C<EXPR> does not begin with C<&>. Whether this is a
false positive or not cannot be determined by a static parse.

=cut

my $DESC = q{goto LABEL used};
my $EXPL = q{Considered bad practice};

sub violates {
    my ($self, $elem) = @_;
    return if $elem->content() ne 'goto';
    my $target = $elem->snext_sibling();
    return $self->violation('Nothing following "goto"?',
        'It seems there is a lone "goto" in your code?',
        $elem) if !$target;
    return if $target->isa('PPI::Token::Symbol') && $target->raw_type 
+eq '&'
           || $target->isa('PPI::Token::Cast')   && $target->content  
+eq '&'
           || $target->isa('PPI::Token::Word')   && $target->content  
+eq '__SUB__';
    return $self->violation($DESC,$EXPL,$elem);
}

1;

[download]

Test code:

#!/usr/bin/env perl
use warnings;
use strict;
use feature 'current_sub'; # Perl 5.16, for __SUB__()

# tests for Perl::Critic::Policy::ControlStructures::ProhibitGotoLabel
# run me with e.g.: perl -c gototest.pl && perlcritic -3 gototest.pl

goto FOO;  # bad
FOO:

sub foo { }
sub bar { goto &foo }  # good

my $i = 1;
goto ("FOO", "BAR", "GLARCH")[$i];  # bad
BAR:

sub quz { goto __SUB__ }     # good
sub quz2 { goto __SUB__() }  # good

my $subref = \&foo;
sub ab { goto &$subref; }  # good
sub cd { goto $subref;  }  # good, but false positive

my $label = "XYZ";
goto $label;  # bad (but ambigious)
XYZ:

__END__

gototest.pl syntax OK
goto LABEL used at line 9, column 1.  Considered bad practice.  (Sever
+ity: 3)
goto LABEL used at line 16, column 1.  Considered bad practice.  (Seve
+rity: 3)
goto LABEL used at line 24, column 10.  Considered bad practice.  (Sev
+erity: 3)
goto LABEL used at line 27, column 1.  Considered bad practice.  (Seve
+rity: 3)

[download]

Update: Added handling of __SUB__ keyword, thanks rir!

Replies are listed 'Best First'.
Re^2: Go to perl::critic (goto considered awesome)
by Anonymous Monk on Oct 06, 2019 at 18:19 UTC
    A C<goto LABEL> is considered a bad practice by a number of people, as it can lead to hard-to-understand and brittle spaghetti code.

    Who cares what management thinks? Perl's goto LABEL is an awesome tool when one wants loop-like flow control outside of loops. It's the easy way to implement interactive shell scripts: 

    
INPUT: print 'number> ';
chomp(my $input = <STDIN>);

if ($input and $input =~ /[0-9]+/) {
  print $input, "\n"
}
else {
  goto INPUT
}

    [download]
[reply]
[d/l]
      Perl's goto LABEL is an awesome tool when one wants loop-like flow control outside of loops.

      But unnecessary in many cases:

      my $input;
INPUT: {
    print 'number> ';
    chomp($input = <STDIN>);
    redo INPUT unless $input && $input=~/\A[0-9]+\z/;
}
print $input, "\n";

      [download]

      (Or just use a proper prompting module, such as IO::Prompter.)

      TIMTOWTDI - I'm not saying that goto isn't sometimes an acceptable solution. But IMHO those cases are much more rare than an actual need for goto, especially in a language like Perl that has many other nice options for flow control. And of course if you want to use goto, all Perl::Critic policies are optional; this one just happens to be what the OP wanted. I'm not going to start a debate about whether goto is good or not. Note my wording: "A goto LABEL is considered a bad practice by a number of people, as it can lead to hard-to-understand and brittle spaghetti code." There was a good line by a comedian, paraphrasing: "I love the phrase 'a number of' because it can mean anything. 'A number of supermodels want to sleep with me.' That number is zero."

      Update: Fixed the regex.

[reply]
[d/l]
[select]
        But a labeled block is a single loop, that redo makes infinite. I said outside loops is where goto comes in really handy. I only seem to ever want goto when extending the handling of STDIN of an existing script. Maybe my mind was poisoned by early exposure to BASIC or I just like that Perl has a feature of FORTRAN. Sometimes out of sheer boredom I'll write sweet spaghetti code on purpose because it's fun and easy and, as we all know, good Perl scripts tend to be so perfect they don't require maintenance. =)
[reply]

      Who cares what management thinks?

      Employees? Duh :)

[reply]
[reply]
Re^2: Go to perl::critic
by Anonymous Monk on Oct 06, 2019 at 21:44 UTC

    Hi

    Does that leave a way out for with comment "## nocritic" or some such (whatever the standard)?

    Or is that something you gotta add

[reply]
      Does that leave a way out for with comment "## nocritic" or some such

      Yes, it's a normal Perl::Critic policy, so the line "goto FOO; ## no critic (ProhibitGotoLabel)" won't warn.

[reply]
[d/l]
[reply]

In Section Seekers of Perl Wisdom