try_yyparse breaks Attribute::Handlers

[demerphq]

Description
In response to #20161 we applied c304acb which seems to cause trouble with certain types of Attribute::Handlers. Specifically when handler contains attributes which die during eval to perl :Sig(s, foo) we end up malbehaving in different ways depending on the exact code involved.

Disabling c304acb (or reverting it) fixes the problem, but it is not clear to me if it is the cause of the problem, or whether it just exposes another problem. I think possibly the latter, but i am not sure.

I will post more information about what i know about this ticket as replies.

Steps to Reproduce

Code that fails with c304acb, note the s, ARRAY, but works in older perls (perhaps accidentally)

$ cat ~/scratch/t_eixo_bad.pl 
use Eixo::Base::Util;
sub concat : Sig(s, ARRAY) { }
warn "Done\n";

Code that works with c304acb and in older perls, note the i, ARRAY.

$ cat ~/scratch/t_eixo_ok.pl 
use Eixo::Base::Util;
sub concat : Sig(i, ARRAY) { }
warn "Done\n";

Reduced module with just a little of debug output to see what is going on:

$ cat ~/scratch/lib/Eixo/Base/Util.pm 
package Eixo::Base::Util;
use strict;
use warnings;

use Attribute::Handlers;
use Carp qw(cluck);
use Data::Dumper;

sub UNIVERSAL::Sig :ATTR(CODE) { 
    #cluck("In 'Sig': ", Dumper(\@_));
}
1;

with this I can reproduce the issues with:

./perl -Ilib -I/home/yorton/scratch/lib ~/scratch/t_eixo_bad.pl

from inside of a perl build directory.

Expected behavior
We shouldn't have problems from these examples.

Perl configuration

Summary of my perl5 (revision 5 version 37 subversion 5) configuration:
  Derived from: ac9ba9d6a3979c516130176f25df5d0ac898a553
  Ancestor: f08b7a33d99b9b204260e108bc1789c5392aff36
  Platform:
    osname=linux
    osvers=5.14.0-1052-oem
    archname=x86_64-linux-thread-multi
    uname='linux oncidium 5.14.0-1052-oem #59-ubuntu smp fri sep 9 09:37:59 utc 2022 x86_64 x86_64 x86_64 gnulinux '
    config_args='-Dusethreads -Doptimize=-g -d -Dusedevel -Dcc=ccache gcc -Dld=gcc -DDEBUGGING'
    hint=recommended
    useposix=true
    d_sigaction=define
    useithreads=define
    usemultiplicity=define
    use64bitint=define
    use64bitall=define
    uselongdouble=undef
    usemymalloc=n
    default_inc_excludes_dot=define
  Compiler:
    cc='gcc'
    ccflags ='-D_REENTRANT -D_GNU_SOURCE -fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
    optimize='-g'
    cppflags='-D_REENTRANT -D_GNU_SOURCE -fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include'
    ccversion=''
    gccversion='9.4.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='gcc'
    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=libc-2.31.so
    so=so
    useshrplib=false
    libperl=libperl.a
    gnulibc_version='2.31'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs
    dlext=so
    d_dlsymun=undef
    ccdlflags='-Wl,-E'
    cccdlflags='-fPIC'
    lddlflags='-shared -g -L/usr/local/lib -fstack-protector-strong'


Characteristics of this binary (from libperl): 
  Compile-time options:
    DEBUGGING
    HAS_TIMES
    MULTIPLICITY
    PERLIO_LAYERS
    PERL_COPY_ON_WRITE
    PERL_DONT_CREATE_GVSV
    PERL_HASH_FUNC_SIPHASH13
    PERL_HASH_USE_SBOX32
    PERL_MALLOC_WRAP
    PERL_OP_PARENT
    PERL_PRESERVE_IVUV
    PERL_TRACK_MEMPOOL
    PERL_USE_DEVEL
    PERL_USE_SAFE_PUTENV
    USE_64_BIT_ALL
    USE_64_BIT_INT
    USE_ITHREADS
    USE_LARGE_FILES
    USE_LOCALE
    USE_LOCALE_COLLATE
    USE_LOCALE_CTYPE
    USE_LOCALE_NUMERIC
    USE_LOCALE_TIME
    USE_PERLIO
    USE_PERL_ATOF
    USE_REENTRANT_API
    USE_THREAD_SAFE_LOCALE
  Locally applied patches:
    uncommitted-changes
    0d049322e803fef628ef35405a6bf6f5b9787d28
    3cb2fc532cff5c41e281fb8471b78a97c95180df
    ac9ba9d6a3979c516130176f25df5d0ac898a553
  Built under linux
  Compiled at Oct 14 2022 13:20:57
  %ENV:
    PERLBREW_CONFIGURE_FLAGS="-de -Dcc=ccache\ gcc -Dld=gcc"
    PERLBREW_HOME="/home/yorton/.perlbrew"
    PERLBREW_MANPATH="/home/yorton/perl5/perlbrew/perls/perl-5.34.1/man"
    PERLBREW_PATH="/home/yorton/perl5/perlbrew/bin:/home/yorton/perl5/perlbrew/perls/perl-5.34.1/bin"
    PERLBREW_PERL="perl-5.34.1"
    PERLBREW_ROOT="/home/yorton/perl5/perlbrew"
    PERLBREW_SHELLRC_VERSION="0.88"
    PERLBREW_VERSION="0.88"
  @INC:
    lib
    /usr/local/lib/perl5/site_perl/5.37.5/x86_64-linux-thread-multi
    /usr/local/lib/perl5/site_perl/5.37.5
    /usr/local/lib/perl5/5.37.5/x86_64-linux-thread-multi
    /usr/local/lib/perl5/5.37.5

[haarg]

Reduced test case:

$ perl -e'CHECK { eval "]" }'
Segmentation fault: 11

[haarg]

Also produces a segfault with INIT.

[leonerd]

If it's any help:

$ bleadperl --gdb
GNU gdb (Debian 12.1-3) 12.1
...
(gdb) run
Starting program: /home/leo/perl5/perlbrew/perls/bleadperl/bin/perl 
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so.1".
CHECK { eval "]"; }
perl: pp_hot.c:5113: Perl_pp_leavesub: Assertion `CxTYPE(cx) == CXt_SUB' failed.

Program received signal SIGABRT, Aborted.
__pthread_kill_implementation (threadid=<optimized out>, signo=signo@entry=6, no_tid=no_tid@entry=0) at ./nptl/pthread_kill.c:44
44      ./nptl/pthread_kill.c: No such file or directory.
(gdb) bt
#0  __pthread_kill_implementation (threadid=<optimized out>, signo=signo@entry=6, no_tid=no_tid@entry=0)
    at ./nptl/pthread_kill.c:44
#1  0x00007ffff7d0e89f in __pthread_kill_internal (signo=6, threadid=<optimized out>)
    at ./nptl/pthread_kill.c:78
#2  0x00007ffff7cc2a52 in __GI_raise (sig=sig@entry=6) at ../sysdeps/posix/raise.c:26
#3  0x00007ffff7cad469 in __GI_abort () at ./stdlib/abort.c:79
#4  0x00007ffff7cad395 in __assert_fail_base (fmt=0x7ffff7e3ac30 "%s%s%s:%u: %s%sAssertion `%s' failed.\n%n", 
    assertion=0x555555b9357e "CxTYPE(cx) == CXt_SUB", file=0x555555b93f14 "pp_hot.c", line=5113, 
    function=<optimized out>) at ./assert/assert.c:92
#5  0x00007ffff7cbbb02 in __GI___assert_fail (assertion=0x555555b9357e "CxTYPE(cx) == CXt_SUB", 
    file=0x555555b93f14 "pp_hot.c", line=5113, 
    function=0x555555b96540 <__PRETTY_FUNCTION__.25> "Perl_pp_leavesub") at ./assert/assert.c:101
#6  0x00005555557cb40e in Perl_pp_leavesub (my_perl=0x555555c5a2a0) at pp_hot.c:5113
#7  0x000055555574b3be in Perl_runops_debug (my_perl=0x555555c5a2a0) at dump.c:2753
#8  0x00005555555eaa60 in S_run_body (my_perl=0x555555c5a2a0, oldscope=1) at perl.c:2776
#9  0x00005555555e9d68 in perl_run (my_perl=0x555555c5a2a0) at perl.c:2704
#10 0x000055555559a2a9 in main (argc=1, argv=0x7fffffffdfc8, env=0x7fffffffdfd8) at perlmain.c:107

[demerphq]

A few notes. Attribute::Handler uses eval to turn the insides of a parenthesized attribute into a perl data structure, if that eval dies it passes the raw string into the handler logic instead of a data structure. Changing the code involved a bit to something different but equivalent makes it easier to debug, especially under perl -Dl

--- a/dist/Attribute-Handlers/lib/Attribute/Handlers.pm
+++ b/dist/Attribute-Handlers/lib/Attribute/Handlers.pm
@@ -249,12 +249,18 @@ sub _apply_handler_AH_ {
        no warnings;
        if (!$raw && defined($data)) {
            if ($data ne '') {
-               my $evaled = eval("package $pkg; no warnings; no strict;
-                                  local \$SIG{__WARN__}=sub{die}; [$data]");
-               $data = $evaled unless $@;
+                local $SIG{__WARN__} = sub{ die @_ };
+                no warnings;
+                no strict;
+                my $code= "package $pkg; my \$ref= [$data]; \$data= \$ref; 1";
+                print STDERR "Evaling '$code'\n";
+                eval($code) or
+                    print STDERR "Code died: $@";
            }
            else { $data = undef }
        }

The print STDERR's show the eval happening.

This eval is executed to handle the contents of the parens in something like sub foo Sig:(s,i), it happens that s,i is parsed as a s/// operator using , as the separator, and thus the expression produces a hard error during the yyparse call. We get this (line numbers here may not line up exactly with blead, I have added some asserts and debugs to my local copy which might affect the line numbers):

#0  Perl_die_unwind (my_perl=0x555555c2d2a0, msv=0x555555c63dc0) at pp_ctl.c:1865
#1  0x0000555555743cf2 in Perl_vcroak (my_perl=0x555555c2d2a0, 
    pat=0x5555559de398 "Substitution pattern not terminated", args=0x7fffffffc740) at util.c:2011
#2  0x0000555555743e7c in Perl_croak (my_perl=0x555555c2d2a0, 
    pat=0x5555559de398 "Substitution pattern not terminated") at util.c:2062
#3  0x000055555566cdbc in S_scan_subst (my_perl=0x555555c2d2a0, start=0x555555c728c1 ", ARRAY]; $data= $ref; 1\n;")
    at toke.c:10530
#4  0x000055555565db0e in yyl_word_or_keyword (my_perl=0x555555c2d2a0, 
    s=0x555555c728c1 ", ARRAY]; $data= $ref; 1\n;", len=1, key=180, orig_keyword=0, c=...) at toke.c:8390
#5  0x0000555555661550 in yyl_keylookup (my_perl=0x555555c2d2a0, s=0x555555c728c1 ", ARRAY]; $data= $ref; 1\n;", 
    gv=0x0) at toke.c:8831
#6  0x0000555555664460 in yyl_try (my_perl=0x555555c2d2a0, s=0x555555c728c0 "s, ARRAY]; $data= $ref; 1\n;")
    at toke.c:9316
#7  0x0000555555665f33 in Perl_yylex (my_perl=0x555555c2d2a0) at toke.c:9618
#8  0x000055555567d905 in Perl_yyparse (my_perl=0x555555c2d2a0, gramtype=258) at perly.c:357
#9  0x0000555555880383 in S_try_yyparse (my_perl=0x555555c2d2a0, gramtype=258) at pp_ctl.c:3545
#10 0x0000555555882233 in S_doeval_compile (my_perl=0x555555c2d2a0, gimme=2 '\002', outside=0x555555daf6e0, seq=1141, 
    hh=0x0) at pp_ctl.c:3729
#11 0x000055555588a2fc in Perl_pp_entereval (my_perl=0x555555c2d2a0) at pp_ctl.c:4738
#12 0x000055555573b565 in Perl_runops_debug (my_perl=0x555555c2d2a0) at dump.c:2730
#13 0x00005555555e93a1 in Perl_call_sv (my_perl=0x555555c2d2a0, sv=0x555555dafa10, flags=13) at perl.c:3121
#14 0x00005555555f410a in Perl_call_list (my_perl=0x555555c2d2a0, oldscope=1, paramList=0x555555dafe18) at perl.c:5192
#15 0x00005555555e4295 in perl_parse (my_perl=0x555555c2d2a0, xsinit=0x55555559a3da <xs_init>, argc=5, 
    argv=0x7fffffffdb58, env=0x0) at perl.c:1911
#16 0x000055555559a308 in main (argc=5, argv=0x7fffffffdb58, env=0x7fffffffdb88) at perlmain.c:106

When this eval dies and c304acb is enabled control is returned back to try_yyparse(), PL_restartop is set, and the doeval_compile() returns FALSE to pp_entereval, which then returns PL_op->opnext, which happens to be set to the same thing as PL_restartop. If c304acb is disabled then PL_restartop is set, control returns further up the stack to the run loop in call_sv(), which then executes PL_restartop in a new run loop.

Notice all of this is happening inside of perl_parse and that the main run loop hasn't really started yet, we haven't executed perl_run() at this time. the relevant code from perlmain.c looks like this:

    if (!perl_parse(my_perl, xs_init, argc, argv, (char **)NULL))
        perl_run(my_perl);

so we are still inside of perl_parse, right at the end actually, executing the CHECK blocks after the main perl_parse has finished. If you inspect perl_run() it is a setjmp/longjmp wrapper for run_body(), and run_body() will run the PL_restartop() if it is set. The end result seems to be that we run the PL_restartop twice, and things go boom. Adding an assert(!PL_restartop) to the start of perl_run() demonstrates the issue.

[demerphq]

@haarg @leonerd, with that test case and some debug and extra asserts I have added we get this:

$ ./perl -Dl -le'CHECK { eval "]"; }'
(-e:0)	ENTER scope 2 (savestack=58) at op.c:11010
(-e:0)	LEAVE scope 2 (savestack=66) at op.c:11050
(-e:0)	savestack: releasing items 66 -> 58
(-e:0)	ENTER scope 2 (savestack=60) at perly.c:289
(-e:1)	ENTER scope 3 (savestack=98) at toke.c:4868
(-e:1)	LEAVE scope 3 (savestack=101) at toke.c:4871
(-e:1)	savestack: releasing items 101 -> 98
(-e:1)	savestack: releasing items 146 -> 129
(-e:1)	ENTER scope 3 (savestack=131) at peep.c:1021
(-e:1)	LEAVE scope 3 (savestack=134) at peep.c:1026
(-e:1)	savestack: releasing items 134 -> 131
(-e:1)	ENTER scope 3 (savestack=131) at peep.c:2702
(-e:1)	LEAVE scope 3 (savestack=136) at peep.c:4157
(-e:1)	savestack: releasing items 136 -> 131
(-e:1)	ENTER scope 3 (savestack=131) at peep.c:1174
(-e:1)	LEAVE scope 3 (savestack=134) at peep.c:1179
(-e:1)	savestack: releasing items 134 -> 131
(-e:1)	savestack: releasing items 131 -> 100
(-e:2)	ENTER scope 3 (savestack=100) at toke.c:4868
(-e:2)	LEAVE scope 3 (savestack=103) at toke.c:4871
(-e:2)	savestack: releasing items 103 -> 100
(-e:1)	savestack: releasing items 100 -> 81
(-e:1)	ENTER scope 3 (savestack=81) at peep.c:1021
(-e:1)	LEAVE scope 3 (savestack=84) at peep.c:1026
(-e:1)	savestack: releasing items 84 -> 81
(-e:1)	ENTER scope 3 (savestack=81) at peep.c:2702
(-e:1)	LEAVE scope 3 (savestack=86) at peep.c:4157
(-e:1)	savestack: releasing items 86 -> 81
(-e:1)	ENTER scope 3 (savestack=81) at peep.c:1174
(-e:1)	LEAVE scope 3 (savestack=84) at peep.c:1179
(-e:1)	savestack: releasing items 84 -> 81
(-e:1)	LEAVE scope 2 (savestack=81) at perly.c:608
(-e:1)	savestack: releasing items 81 -> 60
(-e:0)	LEAVE scope 1 (savestack=60) at perl.c:2615
(-e:0)	savestack: releasing items 60 -> 0
(-e:0)	ENTER scope 1 (savestack=0) at perl.c:2628
(-e:0)	JMPENV_PUSH pre level=2 in Perl_call_list at perl.c:5190
(-e:0)	JMPENV_PUSH level=3 ret=0 in Perl_call_list at perl.c:5190
(-e:0)	ENTER scope 2 (savestack=2) at perl.c:3054
(-e:0)	CX 0 PUSH EVAL (scope 2,2) (save 6,6) in Perl_cx_pushblock at inline.h:2708
(-e:0)	JMPENV_PUSH pre level=3 in Perl_call_sv at perl.c:3117
(-e:0)	JMPENV_PUSH level=4 ret=0 in Perl_call_sv at perl.c:3117
(-e:0)	CX 1 PUSH SUB (scope 2,2) (save 6,6) in Perl_cx_pushblock at inline.h:2708
(-e:0)	Entering new RUNOPS level
(-e:0)	ENTER scope 3 (savestack=6) at dump.c:2706
(-e:0)	LEAVE scope 3 (savestack=8) at dump.c:2726
(-e:0)	savestack: releasing items 8 -> 6
(-e:1)	ENTER scope 3 (savestack=6) at dump.c:2706
(-e:1)	LEAVE scope 3 (savestack=8) at dump.c:2726
(-e:1)	savestack: releasing items 8 -> 6
(-e:1)	ENTER scope 3 (savestack=6) at dump.c:2706
(-e:1)	LEAVE scope 3 (savestack=8) at dump.c:2726
(-e:1)	savestack: releasing items 8 -> 6
(-e:1)	CX 2 PUSH EVAL (scope 2,2) (save 13,6) in Perl_cx_pushblock at inline.h:2708
(-e:1)	ENTER "evalcomp" scope 3 (savestack=46) at pp_ctl.c:3656
pre PL_restartop=0
((eval 1):1)	JMPENV_PUSH pre level=4 in S_try_yyparse at pp_ctl.c:3542
((eval 1):1)	JMPENV_PUSH level=5 ret=0 in S_try_yyparse at pp_ctl.c:3542
((eval 1):1)	ENTER scope 4 (savestack=54) at perly.c:289
((eval 1):1)	(dopoptoeval(): found eval at cx=2)
((eval 1):1)	savestack: releasing items 94 -> 6
(-e:1)	CX 2 POP EVAL (scope 4,2) (save 6,6) in Perl_cx_popblock at inline.h:2720
(-e:1)	JMPENV_JUMP(3) level=4 in Perl_die_unwind at pp_ctl.c:1865
(-e:1)	JMPENV_PUSH level=5 ret=3 in S_try_yyparse at pp_ctl.c:3542
(-e:1)	JMPENV_POP level=4 in S_try_yyparse at pp_ctl.c:3554
bad: PL_restartop=557e18fa59d8
PL_restartop=557e18fa59d8 op_next=557e18fa59d8
(-e:1)	ENTER scope 3 (savestack=6) at dump.c:2706
(-e:1)	LEAVE scope 3 (savestack=8) at dump.c:2726
(-e:1)	savestack: releasing items 8 -> 6
(-e:1)	CX 1 POP SUB (scope 2,2) (save 6,6) in Perl_cx_popblock at inline.h:2720
(-e:0)	leaving RUNOPS level
(-e:0)	CX 0 POP EVAL (scope 2,2) (save 6,6) in Perl_cx_popblock at inline.h:2720
(-e:0)	JMPENV_POP level=3 in Perl_call_sv at perl.c:3162
(-e:0)	LEAVE scope 2 (savestack=6) at perl.c:3169
(-e:0)	savestack: releasing items 6 -> 2
(-e:0)	JMPENV_POP level=2 in Perl_call_list at perl.c:5238
(-e:0)	JMPENV_POP level=1 in perl_parse at perl.c:1946
perl: perl.c:2691: perl_run: Assertion `!PL_restartop' failed.
Aborted (core dumped)

The simplification helps, thanks. Still digging, so if you havent any ideas feel free to let me know.

[demerphq]

I am hopeful that the patch in #20398 fixes this.