How can I force exiting a perl subroutine/closure via last/next to fail the program automatically?

Question

Given the following fully functional perl script and module:

tx_exec.pl:

#!/usr/bin/perl

use strict; # make sure $PWD is in your PERL5LIB
# no warnings!

use tx_exec qw(tx_exec);

tx_exec ("normal", sub { return "foobar"; });
tx_exec ("die", sub { die "barbaz\n"; });
tx_exec ("last", sub { last; });
tx_exec ("next", sub { next; });

tx_exec.pm:

package tx_exec;

use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(tx_exec);

my $MAX_TRIES = 3;

sub tx_exec {
    my ($desc, $sub, $args) = @_;
    print "\ntx_exec($desc):\n";
    my $try = 0;
    while (1) {
        $try++;
        my $sub_ret;
        my $ok = eval {
            # start transaction
            $sub_ret = $sub->($args);
            # commit transaction
            1;
        };

        unless ($ok) {
            print "failed with error: $@";
            # rollback transaction
            if ($try >= $MAX_TRIES) {
                print "failed after $try tries\n";
                return (undef, undef);
            }
            print "try #$try failed, retrying...\n";
            next;
        }
        # some cleanup
        print "returning (1, ".($sub_ret//'<undef>').")\n";
        return (1, $sub_ret);
    }
}

I get the following output:

$ ./tx_exec.pl
tx_exec(normal):
returning (1, foobar)

tx_exec(die):
failed with error: barbaz
try #1 failed, retrying...
failed with error: barbaz
try #2 failed, retrying...
failed with error: barbaz
failed after 3 tries

tx_exec(last):

tx_exec(next):
# infinite loop

I understand what is happening, and I'm getting a warning about it if I turn on warnings in the script defining the closures. However, can I force the program to fail/die automatically/idiomatically, when next/last would exit a closure-subroutine like here, under the following strict circumstances:

• The $sub being passed is a closure and not a simple function (a simple function dies on bare next/last anyway, which is trivial to handle)
• The library code (tx_exec) and the client code (invoking it) are in separate compilation units and the client does not use warnings.

Using perl 5.16.2 (without possibility of upgrading).

Here is a github gist documenting all the approaches so far:

• use warnings FATAL => qw(exiting) doesn't make a difference in library code
• local $SIG handler doesn't work if the call site doesn't have FATAL => qw(exiting) warning enabled
• manual detection works, but is somewhat cumbersome and all over the place (nonlocalized)
• ysth's approach with a bare block works best, as it catches the last/next, fully localizing manual detection and guaranteeing that nothing can go wrong (except next/last with labels, which is easier to avoid).

Answer 1

For lack of @ysth's involvement in writing an answer, I'm writing the best solution I found so far, inspired by his first attempt from the comments to the question. (I will re-accept ysth's answer if he posts it later).

---

The eval calling the coderef needs to look like this:

my $ok = eval {
    # start transaction
    my $proper_return = 0;
    {
        $sub_ret = $sub->($args);
        $proper_return = 1;
    }
    die "Usage of `next` or `last` disallowed in coderef passed to tx_exec\n" unless $proper_return;
    # commit transaction
    1;
};

The bare block is acting as a loop which will immediately exit on either next or last, so whether we land after the bare block, or within it, from calling the coderef, we can deduce whether the coderef executed next/last and act appropriately.

More on bare block semantics and their interaction with next/last can be found here.

It is left as an exercise for the reader to handle the rarely seen redo in the code above.

Answer 2

Short   Using next/last in the sub (that caller passes as coderef) triggers an exception, if not within a "loop block." This affords an easy handling of such use, with a small change of tx_exec().

---

The wrong use of last/next raised in the question is a little nuanced. First, from last

last cannot be used to exit a block that returns a value such as eval {}, sub {}, or do {}, and should not be used to exit a grep or map operation.

and for doing this in a sub or eval we get a warning

Exiting subroutine via last at ...

(and for "eval"), and similarly for next. These are classified as W in perldiag and can be controlled by using/not the warnings pragma.^† This fact foils attempts to make such use fatal by FATAL => 'exiting' warning or by $SIG{__WARN__} hook.

However, if such use of next or last (in a sub or eval) has no "loop block" in any enclosing scope (or call stack) then it also raises an exception.^‡ The message is

Can't "last" outside a loop block...

and similarly for next. It is found in perldiag (search for outside a loop), classified as F.

Then one solution for the posed problem is to run the coderef passed by caller outside of loop blocks, and we get the interpreter to check for and alert us to (raise exception) the offending use. As the while (1) loop is there only to be able to try multiple times this can be implemented.

The coderef can be run and tested against this exception in a utility routine

sub run_coderef {
    my ($sub, @args) = @_; 

    my $sub_ret;
    my $ok = eval { $sub_ret = $sub->(@args); 1 };
    if (not $ok) { 
        if ($@ =~ /^Can't "(?:next|last)"/) {  #'
            die $@;                            # disallow such use
        }
        else { return }                        # other error, perhaps retry
    }   
    else { return $sub_ret }
}

which can be used like

sub tx_exec {
    my ($sub, @args) = @_; 

    my $sub_ret = run_coderef($sub, @args);

    my $run_again = (defined $sub_ret) ? 0 : 1;

    if ($run_again) { 
        my $MAX_TRIES = 3;
        my $try = 0;

        while (1) { 
            ++$try;
            $sub_ret = run_coderef($sub, @args);

            if ( not defined $sub_ret ) {  # "other error", run again
                if ($try >= $MAX_TRIES) { 
                    print "failed after $try tries\n";
                   return (undef, undef);
                }
                print "try #$try failed, retrying...\n";
                next;
            }
            ...
        }
    }
}   

This approach makes perfect sense design wise: it allows an exception to be raised for the disallowed use, and it localizes the handling in its own sub.

The disallowed behavior is checked for really only on the first run, since after that run_coderef is called out of a loop, in which case (this) exception isn't thrown. This is fine since the repeated runs (for "allowed" failures) are executed with that same sub so it is enough to check the first use.

On the other hand, it also means that we can

• run eval { $sub_ret = $sub->(@args) ... } directly in the while (1), since we have checked for bad use of last/next on the first run

• Can add further cases to check for in run_coderef, making it a more rounded checker/enforcer. The first example is the Exiting warnings, which we can make fatal and check for them as well. This will be useful if warnings in the caller are enabled

This approach can be foiled but the caller would have to go out of their way toward that end.

Tested with v5.16.3 and v5.26.2.

---

^† Btw, you can't fight a caller's decision to turn off warnings. Let them be. It's their code.

^‡ This can be checked with

perl -wE'sub tt { last }; do { tt() }; say "done"'

where we get

Exiting subroutine via last at -e line 1.
Can't "last" outside a loop block at -e line 

while if there is a "loopy" block

perl -wE'sub tt { last }; { do { tt() } }; say "done"'

we get to see the end of the program, no exception

Exiting subroutine via last at -e line 1.
done

The extra block { ... } "semantically identical to a loop that executes once" (next).

This can be checked for eval by printing its message in $@.

---

The original post, based on the expectation that only warnings are emitted

The warnings pragma is lexical, so adding per ysth comment

use warnings FATAL => 'exiting';

in the sub itself (or in eval to scope it more tightly) should work under the restrictions

sub tx_exec { 
    use warnings FATAL => "exiting"; 

    my ($sub, $args) = @_; 
    $sub->($args);        
}; 

since the warning fires inside the tx_exec scope. In my test the call to this with a coderef not doing last/next first runs fine, and it dies only for a later call with them.

Or, can implement it using $SIG{__WARN__} "signal" (hook)

sub tx_exec {   
    local $SIG{__WARN__} = sub { 
        die @_ if $_[0] =~ /^Exiting subroutine via (?:last|next)/; 
        warn @_ 
    };

    my ($sub, $args) = @_;
    ...
}

Answer 3

This is the manual approach I was mentioning in the question. So far this was the only approach that helped me cleanly handle misbehaving client code, without any assumptions or expectations.

I'd prefer, and will gladly consider, a more idiomatic approach, like the local $SIG or use warnings FATAL => 'exiting', if they work without any expectation from client code (specifically that it has warnings enabled in any form).

tx_exec.pl:

#!/usr/bin/perl

use strict;
# no warnings!

use tx_exec qw(tx_exec);

tx_exec ("normal", sub { return "foobar"; });
tx_exec ("die", sub { die "barbaz\n"; });
tx_exec ("last", sub { last; });
tx_exec ("next", sub { next; });

tx_exec.pm:

package tx_exec;

use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(tx_exec);

my $MAX_TRIES = 3;

sub tx_exec {
    my ($desc, $sub, $args) = @_;
    print "\ntx_exec($desc):\n";
    my $try = 0;
    my $running = 0;
    while (1) {
        $try++;
        my $sub_ret;
        my $ok = eval {
            # start transaction
            die "Usage of `next` disallowed in closure passed to tx_exec\n" if $running;
            $running = 1;
            $sub_ret = $sub->($args);
            print "sub returned properly\n";
            # commit transaction
            1;
        };

        $running = 0;

        unless ($ok) {
            if ($@ =~ /^Usage of `next`/) {
                print $@;
                return (undef, undef); # don't retry
            }
            print "failed with error: $@";
            # rollback transaction
            if ($try >= $MAX_TRIES) {
                print "failed after $try tries\n";
                return (undef, undef);
            }
            print "try #$try failed, retrying...\n";
            next;
        }
        # some cleanup
        print "returning (1, ".($sub_ret//'<undef>').")\n";
        return (1, $sub_ret);
    }
    print "Usage of `last` disallowed in closure passed to tx_exec\n";
    return (undef, undef);
}

output:

tx_exec(normal):
sub returned properly
returning (1, foobar)

tx_exec(die):
failed with error: barbaz
try #1 failed, retrying...
failed with error: barbaz
try #2 failed, retrying...
failed with error: barbaz
failed after 3 tries

tx_exec(last):
Usage of `last` disallowed in closure passed to tx_exec

tx_exec(next):
Usage of `next` disallowed in closure passed to tx_exec