[perl #134179] Storable: sv_upgrade from type 7 down to type 1

# New Ticket Created by  Dagfinn Ilmari Mannsåker 
# Please include the string:  [perl #134179]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org/Ticket/Display.html?id=134179 >


Hi Porters,

daxim reported on IRC that the following program errors with $subject

    use Storable qw(dclone);
    use Scalar::Util qw(weaken);

    my $foo = [qr//,[]];
    weaken($foo->[1][0][0] = $foo->[1]);
    dclone $foo;

Both the preceding qr// and the two-level weakened cycle are necessary
to trigger it.

Backtrace:

$ gdb -q --args perl -MStorable=dclone -MScalar::Util=weaken \
      -e 'my $foo = [qr//,[]]; weaken($foo->[1][0][0] = $foo->[1]); dclone $foo;'
Reading symbols from perl...done.
(gdb) b Perl_croak
Function "Perl_croak" not defined.
Make breakpoint pending on future shared library load? (y or [n]) y
Breakpoint 1 (Perl_croak) pending.
(gdb) r
Starting program: /home/ilmari/perl5/perlbrew/perls/30.0td/bin/perl -MStorable=dclone -MScalar::Util=weaken -e my\ \$foo\ =\ \[qr//,\[\]\]\;\ weaken\(\$foo-\>\[1\]\[0\]\[0\]\ =\ \$foo-\>\[1\]\)\;\ dclone\ \$foo\;
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so.1".

Breakpoint 1, Perl_croak (my_perl=my_perl@entry=0x555555757010, pat=pat@entry=0x7ffff7b49ee0 "sv_upgrade from type %d down to type %d")
    at util.c:1753
1753	{
(gdb) bt full
#0  Perl_croak (my_perl=my_perl@entry=0x555555757010, pat=pat@entry=0x7ffff7b49ee0 "sv_upgrade from type %d down to type %d") at util.c:1753
        args = {{gp_offset = 27, fp_offset = 0, overflow_arg_area = 0x7ffff6206717 <retrieve+903>, reg_save_area = 0x555555757010}}
#1  0x00007ffff78d16e6 in Perl_sv_upgrade (my_perl=my_perl@entry=0x555555757010, sv=sv@entry=0x555555794858, new_type=new_type@entry=SVt_IV)
    at sv.c:1307
        old_body = <optimized out>
        new_body = <optimized out>
        old_type = SVt_PVMG
        new_type_details = <optimized out>
        old_type_details = 0x7ffff7b56798 <bodies_by_type+56>
        referent = <optimized out>
        __PRETTY_FUNCTION__ = "Perl_sv_upgrade"
#2  0x00007ffff620d0b5 in retrieve_ref (my_perl=0x555555757010, cxt=0x555555795378, cname=0x0) at Storable.xs:5435
        rv = 0x555555794858
        sv = 0x555555794450
        stash = 0x0
        __PRETTY_FUNCTION__ = "retrieve_ref"
#3  0x00007ffff6206717 in retrieve (my_perl=my_perl@entry=0x555555757010, cxt=cxt@entry=0x555555795378, cname=cname@entry=0x0)
    at Storable.xs:7350
        type = 4
        svh = <optimized out>
        sv = <optimized out>
        __PRETTY_FUNCTION__ = "retrieve"
#4  0x00007ffff6215735 in retrieve_array (my_perl=0x555555757010, cxt=0x555555795378, cname=<optimized out>) at Storable.xs:6292
        len = 1
        i = 0
        av = 0x5555557887e8
        sv = <optimized out>
        stash = <optimized out>
        seen_null = false
        __PRETTY_FUNCTION__ = "retrieve_array"
#5  0x00007ffff6206717 in retrieve (my_perl=my_perl@entry=0x555555757010, cxt=cxt@entry=0x555555795378, cname=cname@entry=0x0)
    at Storable.xs:7350
        type = 2
        svh = <optimized out>
        sv = <optimized out>
        __PRETTY_FUNCTION__ = "retrieve"
#6  0x00007ffff620ce34 in retrieve_ref (my_perl=0x555555757010, cxt=0x555555795378, cname=0x0) at Storable.xs:5410
        rv = 0x55555575a348
        sv = <optimized out>
        stash = 0x0
        __PRETTY_FUNCTION__ = "retrieve_ref"
#7  0x00007ffff6206717 in retrieve (my_perl=my_perl@entry=0x555555757010, cxt=cxt@entry=0x555555795378, cname=cname@entry=0x0)
    at Storable.xs:7350
        type = 4
        svh = <optimized out>
        sv = <optimized out>
        __PRETTY_FUNCTION__ = "retrieve"
#8  0x00007ffff6215735 in retrieve_array (my_perl=0x555555757010, cxt=0x555555795378, cname=<optimized out>) at Storable.xs:6292
        len = 2
        i = 1
        av = 0x55555577d520
        sv = <optimized out>
        stash = <optimized out>
        seen_null = false
        __PRETTY_FUNCTION__ = "retrieve_array"
#9  0x00007ffff6206717 in retrieve (my_perl=my_perl@entry=0x555555757010, cxt=cxt@entry=0x555555795378, cname=cname@entry=0x0)
    at Storable.xs:7350
        type = 2
        svh = <optimized out>
        sv = <optimized out>
        __PRETTY_FUNCTION__ = "retrieve"
#10 0x00007ffff6207d1d in do_retrieve (my_perl=my_perl@entry=0x555555757010, f=f@entry=0x0, in=in@entry=0x0, optype=6, optype@entry=4, 
    flags=flags@entry=6) at Storable.xs:7540
        perinterp_sv = <optimized out>
        cxt = 0x555555795378
        __PRETTY_FUNCTION__ = "do_retrieve"
        sv = <optimized out>
        is_tainted = <optimized out>
        pre_06_fmt = 0
#11 0x00007ffff620b60d in dclone (sv=0x5555557888a8, my_perl=0x555555757010) at Storable.xs:7741
        cxt = 0x555555795378
        real_context = 0x555555795378
        perinterp_sv = <optimized out>
        size = 51
        out = <optimized out>
#12 XS_Storable_dclone (my_perl=0x555555757010, cv=<optimized out>) at Storable.xs:7879
        sv = 0x5555557888a8
        RETVAL = <optimized out>
        sp = <optimized out>
        ax = 1
        mark = <optimized out>
        items = <optimized out>
#13 0x00007ffff78b5236 in Perl_pp_entersub (my_perl=0x555555757010) at pp_hot.c:5237
        is_scalar = <optimized out>
        sp = <optimized out>
        sv = 0x555555788d40
        gv = 0x7ffff78a3e87 <Perl_pp_sassign+119>
        cv = <optimized out>
        old_savestack_ix = <optimized out>
        __PRETTY_FUNCTION__ = "Perl_pp_entersub"
#14 0x00007ffff786d10a in Perl_runops_debug (my_perl=0x555555757010) at dump.c:2537
        orig_stack_hwm = 0
#15 0x00007ffff77ccb5b in S_run_body (oldscope=1, my_perl=0x555555757010) at perl.c:2716
No locals.
#16 perl_run (my_perl=0x555555757010) at perl.c:2639
        oldscope = 1
        ret = <optimized out>
        cur_env = {je_prev = 0x555555757320, je_buf = {{__jmpbuf = {1, -5698547751553798909, 93824992235440, 140737488346176, 0, 0, 
                -1891542260264669949, -1891523593628226301}, __mask_was_saved = 0, __saved_mask = {__val = {93824994451896, 93824994451944, 
                  93824994451992, 93824994452040, 93824994452088, 93824994452136, 93824994452184, 93824994340880, 140737353934488, 
                  993451154919501312, 140737488346176, 93824994340880, 139637976727552, 0, 140737488346176, 993451154919501312}}}}, 
          je_ret = 0, je_mustcatch = false, je_old_delaymagic = 0, je_old_stack_hwm = 0}
        __PRETTY_FUNCTION__ = "perl_run"
#17 0x0000555555554f98 in main (argc=<optimized out>, argv=<optimized out>, env=<optimized out>) at perlmain.c:127
        exitstatus = <optimized out>
        i = <optimized out>


Summary of my perl5 (revision 5 version 30 subversion 0) configuration:
   
  Platform:
    osname=linux
    osvers=4.19.0-0.bpo.4-amd64
    archname=x86_64-linux-thread-multi
    uname='linux ilmari-thinkpad 4.19.0-0.bpo.4-amd64 #1 smp debian 4.19.28-2~bpo9+1 (2019-03-27) x86_64 gnulinux '
    config_args='-de -Dprefix=/home/ilmari/perl5/perlbrew/perls/30.0td -Duseshrplib -Dusethreads -Dman1dir=none -Dman3dir=none -DDEBUGGING -Aeval:scriptdir=/home/ilmari/perl5/perlbrew/perls/30.0td/bin'
    hint=recommended
    useposix=true
    d_sigaction=define
    useithreads=define
    usemultiplicity=define
    use64bitint=define
    use64bitall=define
    uselongdouble=undef
    usemymalloc=n
    default_inc_excludes_dot=define
    bincompat5005=undef
  Compiler:
    cc='cc'
    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 -D_FORTIFY_SOURCE=2'
    optimize='-O2 -g'
    cppflags='-D_REENTRANT -D_GNU_SOURCE -fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include'
    ccversion=''
    gccversion='6.3.0 20170516'
    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/gcc/x86_64-linux-gnu/6/include-fixed /usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib
    libs=-lpthread -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat
    perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    libc=libc-2.24.so
    so=so
    useshrplib=true
    libperl=libperl.so
    gnulibc_version='2.24'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs
    dlext=so
    d_dlsymun=undef
    ccdlflags='-Wl,-E -Wl,-rpath,/home/ilmari/perl5/perlbrew/perls/30.0td/lib/5.30.0/x86_64-linux-thread-multi/CORE'
    cccdlflags='-fPIC'
    lddlflags='-shared -O2 -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_IMPLICIT_CONTEXT
    PERL_MALLOC_WRAP
    PERL_OP_PARENT
    PERL_PRESERVE_IVUV
    PERL_TRACK_MEMPOOL
    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
  Built under linux
  Compiled at May 24 2019 16:22:48
  %ENV:
    PERL5LIB="/home/ilmari/.perlbrew/libs/30.0td@std/lib/perl5"
    PERLBREW_HOME="/home/ilmari/.perlbrew"
    PERLBREW_LIB="std"
    PERLBREW_MANPATH="/home/ilmari/.perlbrew/libs/30.0td@std/man:/home/ilmari/perl5/perlbrew/perls/30.0td/man"
    PERLBREW_PATH="/home/ilmari/.perlbrew/libs/30.0td@std/bin:/home/ilmari/perl5/perlbrew/bin:/home/ilmari/perl5/perlbrew/perls/30.0td/bin"
    PERLBREW_PERL="30.0td"
    PERLBREW_ROOT="/home/ilmari/perl5/perlbrew"
    PERLBREW_SHELLRC_VERSION="0.82"
    PERLBREW_VERSION="0.84"
    PERL_LOCAL_LIB_ROOT="/home/ilmari/.perlbrew/libs/30.0td@std"
    PERL_MB_OPT="--install_base /home/ilmari/.perlbrew/libs/30.0td@std"
    PERL_MM_OPT="INSTALL_BASE=/home/ilmari/.perlbrew/libs/30.0td@std"
  @INC:
    /home/ilmari/.perlbrew/libs/30.0td@std/lib/perl5/x86_64-linux-thread-multi
    /home/ilmari/.perlbrew/libs/30.0td@std/lib/perl5
    /home/ilmari/perl5/perlbrew/perls/30.0td/lib/site_perl/5.30.0/x86_64-linux-thread-multi
    /home/ilmari/perl5/perlbrew/perls/30.0td/lib/site_perl/5.30.0
    /home/ilmari/perl5/perlbrew/perls/30.0td/lib/5.30.0/x86_64-linux-thread-multi
    /home/ilmari/perl5/perlbrew/perls/30.0td/lib/5.30.0



-- 
"The surreality of the universe tends towards a maximum" -- Skud's Law
"Never formulate a law or axiom that you're not prepared to live with
 the consequences of."                              -- Skud's Meta-Law

• [perl #134179] Storable: sv_upgrade from type 7 down to type 1 by Dagfinn Ilmari Mannsåker