defer/finally block with caught exception exits current runops loop

[djerius]

---

Description
When calling a subroutine which uses Type::Params::signature inside of a defer block, the process will stop without warning if a multiple signature match is made and the successful match is against the second or later alternate.

Steps to Reproduce

To reproduce the issue, run the following script with the environment variable BUG set to 3.

Setting BUG to 1 or 2 illustrates that Type::Params::signature works in the case that a single signature is available to be matched, or the first alternative in a multiple signature matches.

#! /bin/env perl

use v5.40;

no warnings "experimental::defer";
use feature 'defer';

use Type::Params 'signature';
use Types::Standard qw( Any );


my @sig = (
    # works
    signature( named => [ inst_id => Any ] ),

    # works; the first signature matches
    signature( multiple => [
	{ named => [ inst_id => Any ] },
	{ named => [ tag => Any ] },
    ] ),

    # fails; the second signature matches
    signature( multiple => [
	{ named => [ tag => Any ] },
	{ named => [ inst_id => Any ] },
    ] ),
);

for my $id ( 0 ..1 ) {
    say STDERR "LOOP: $id";
    defer {
	$ENV{BUG} && $sig[ $ENV{BUG} - 1 ]->( inst_id => 0, );
	say STDERR "DEFER: $id";
    }
    say STDERR "PRE-DEFER: $id";
}

For example,

$ BUG=1 perl bug.pl
LOOP: 0
PRE-DEFER: 0
DEFER: 0
LOOP: 1
PRE-DEFER: 1
DEFER: 1

$ BUG=2 perl bug.pl
LOOP: 0
PRE-DEFER: 0
DEFER: 0
LOOP: 1
PRE-DEFER: 1
DEFER: 1

$ BUG=3 perl bug.pl
LOOP: 0
PRE-DEFER: 0
DEFER: 0

If the defer keyword is removed (retaining the code block), the correct output is obtained for BUG=3

---

Flags

• category=core
• severity=high

---

Perl configuration

Site configuration information for perl 5.40.0:

Configured by dj at Mon Aug  5 00:44:06 EDT 2024.

Summary of my perl5 (revision 5 version 40 subversion 0) configuration:
   
  Platform:
    osname=linux
    osvers=6.9.7+bpo-amd64
    archname=x86_64-linux
    uname='linux leafhopper 6.9.7+bpo-amd64 #1 smp preempt_dynamic debian 6.9.7-1~bpo12+1 (2024-07-03) x86_64 gnulinux '
    config_args='-Dprefix=/home/dj/.plenv/versions/5.40 -de -Dversiononly -A'eval:scriptdir=/home/dj/.plenv/versions/5.40/bin''
    hint=recommended
    useposix=true
    d_sigaction=define
    useithreads=undef
    usemultiplicity=undef
    use64bitint=define
    use64bitall=define
    uselongdouble=undef
    usemymalloc=n
    default_inc_excludes_dot=define
  Compiler:
    cc='cc'
    ccflags ='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -D_FORTIFY_SOURCE=2'
    optimize='-O2'
    cppflags='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include'
    ccversion=''
    gccversion='12.2.0'
    gccosandvers=''
    intsize=4
    longsize=8
    ptrsize=8
    doublesize=8
    byteorder=12345678
    doublekind=3
    d_longlong=define
    longlongsize=8
    d_longdbl=define
    longdblsize=16
    longdblkind=3
    ivtype='long'
    ivsize=8
    nvtype='double'
    nvsize=8
    Off_t='off_t'
    lseeksize=8
    alignbytes=8
    prototype=define
  Linker and Libraries:
    ld='cc'
    ldflags =' -fstack-protector-strong -L/usr/local/lib'
    libpth=/usr/local/lib /usr/lib/x86_64-linux-gnu /usr/lib /usr/lib64
    libs=-lpthread -ldl -lm -lcrypt -lutil -lc
    perllibs=-lpthread -ldl -lm -lcrypt -lutil -lc
    libc=/lib/x86_64-linux-gnu/libc.so.6
    so=so
    useshrplib=false
    libperl=libperl.a
    gnulibc_version='2.36'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs
    dlext=so
    d_dlsymun=undef
    ccdlflags='-Wl,-E'
    cccdlflags='-fPIC'
    lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector-strong'


---
@INC for perl 5.40.0:
    /home/dj/.plenv/versions/5.40/lib/perl5/site_perl/5.40.0/x86_64-linux
    /home/dj/.plenv/versions/5.40/lib/perl5/site_perl/5.40.0
    /home/dj/.plenv/versions/5.40/lib/perl5/5.40.0/x86_64-linux
    /home/dj/.plenv/versions/5.40/lib/perl5/5.40.0

---
Environment for perl 5.40.0:
    HOME=/home/dj
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/dj/.plenv/versions/5.40/bin:/home/dj/.plenv/libexec:/home/dj/.plenv/plugins/perl-build/bin:/home/dj/.plenv/plugins/pexec/bin:/home/dj/.plenv/plugins/plenv-contrib/bin:/home/dj/.cargo/bin:/home/dj/.plenv/shims:/home/dj/.plenv/bin:/home/dj/bin:/home/dj/.local/bin:/home/dj/.cargo/bin:/home/dj/miniconda3/condabin:/home/dj/.plenv/shims:/home/dj/.plenv/bin:/home/dj/bin:/home/dj/.local/bin:/home/dj/.plenv/shims:/home/dj/.plenv/bin:/home/dj/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games:/home/dj/root/lua/bin:/home/dj/root/lua/bin
    PERL_BADLANG (unset)
    PERL_CPANM_OPT=--cascade-search --mirror-only  --mirror /home/dj/Work/darkpan --mirror http://www.cpan.org
    PERL_CPAN_MIRROR_TINY_BASE=/home/dj/Work/darkpan
    PERL_DARKPAN=/home/dj/Work/darkpan
    SHELL=/bin/bash

[haarg]

Reduced demonstration case:

#!/usr/bin/env perl
use v5.40;

use experimental 'defer';

for my $id ( 0 .. 1 ) {
    say STDERR "LOOP: $id";
    defer {
        eval { die };
        say STDERR "DEFER: $id";
    }
    say STDERR "PRE-DEFER: $id";
}

[djerius]

Thanks for narrowing it down further. finally has the same issue:

#! /bin/env perl

use v5.40;

use experimental 'try';

for my $id ( 0 .. 1 ) {
    say STDERR "LOOP: $id";
    try { }
    catch ( $e ) { }
    finally {
        eval{ die };
    }
}

[jkeenan]

Since @haarg has demonstrated that this problem is not specific to Type::Params, we should change the subject line of this issue. What should we change it to?

[iabyn]

On Mon, Mar 03, 2025 at 02:46:00PM -0800, James E Keenan wrote: jkeenan left a comment (Perl/perl5#23064) Since @haarg has demonstrated that this problem is not specific to Type::Params, we should change the subject line of this issue. What should we change it to?

I've changed it to: defer/finally block with caught exception exits current runops loop

…

-- The warp engines start playing up a bit, but seem to sort themselves out after a while without any intervention from boy genius Wesley Crusher. -- Things That Never Happen in "Star Trek" #17