PL_sv_undef in OPCONST in ithreads broken

If you generate an OPCONST whose value is a pointer to PL_sv_undef, then it
seems that it can trigger a bug.

My somewhat esoteric test case is:

# use strict;

#use Devel::Peek;
BEGIN {
    $::{Undef} = \undef;
    # Dump \undef;
}

if ($$) {
} else {
  "!$no\n";
}

$undef = Undef;
unless ($undef) {
  print "ok 16\n";
} else {
  print "not ok 16 # \$undef='$undef'\n";
      # Dump \Undef; Dump \undef;
}
__END__


Yes, it's using the new fangled references in typeglobs, but I suspect that
the bug can be triggered with XS code, or anything else that can manage to
get PL_sv_undef into the op_sv of a CONSTOP.

The output I see is

not ok 16 # $undef='
'

It seems that the PAD slot used by the constant that replaces Undef in
C<$undef = Undef;> is double booked by the last pad temporary used by"!$no\n";


$ ./perl -Ilib -MO=Concise t.pl
h  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 5 t.pl:9) v ->3
-     <1> null vK/1 ->6
4        <|> cond_expr(other->5) vK/1 ->s
-           <1> ex-rv2sv sK/1 ->4
3              <#> gvsv[*$] s ->4
-           <@> scope vK ->-
5              <0> stub v ->6
z           <@> leave vKP ->6
s              <0> enter v ->t
t              <;> nextstate(main 3 t.pl:11) v ->u
-              <1> ex-stringify vK/1 ->z
-                 <0> ex-pushmark s ->u
y                 <2> concat[t4] sKS/2 ->z
w                    <2> concat[t3] sK/2 ->x
u                       <$> const[PV "!"] s ->v
-                       <1> ex-rv2sv sK/1 ->w
v                          <#> gvsv[*no] s ->w
x                    <$> const[PV "\n"] s ->y
6     <;> nextstate(main 5 t.pl:14) v ->7
9     <2> sassign vKS/2 ->a
7        <$> const[PV "\n"] s ->8
-        <1> ex-rv2sv sKRM*/1 ->9
8           <#> gvsv[*undef] s ->9
a     <;> nextstate(main 8 t.pl:15) v ->b
-     <1> null vK/1 ->h
d        <|> cond_expr(other->e) vK/1 ->i
c           <1> not sK*/1 ->d
-              <1> ex-rv2sv sK/1 ->c
b                 <#> gvsv[*undef] s ->c
-           <@> scope vK ->-
-              <0> ex-nextstate v ->e
g              <@> print vK ->h
e                 <0> pushmark s ->f
f                 <$> const[PV "ok 16\n"] s ->g
r           <@> leave vKP ->h
i              <0> enter v ->j
j              <;> nextstate(main 6 t.pl:18) v ->k
q              <@> print vK ->r
k                 <0> pushmark s ->l
-                 <1> ex-stringify sK/1 ->q
-                    <0> ex-pushmark s ->l
p                    <2> concat[t11] sKS/2 ->q
n                       <2> concat[t10] sK/2 ->o
l                          <$> const[PV "not ok 16 # $undef='"] s ->m
-                          <1> ex-rv2sv sK/1 ->n
m                             <#> gvsv[*undef] s ->n
o                       <$> const[PV "'\n"] s ->p
t.pl syntax OK




The problem is here:


Hardware watchpoint 17: *(struct sv **) 136264512

Old value = (struct sv *) 0x81f5624
New value = (struct sv *) 0x81f7fcc
Perl_av_store (my_perl=0x81f5000, av=0x81f734c, key=13, val=0x81f7fcc)
    at av.c:335
335         if (SvSMAGICAL(av)) {
(gdb) where
#0  Perl_av_store (my_perl=0x81f5000, av=0x81f734c, key=13, val=0x81f7fcc)
    at av.c:335
#1  0x080e733f in Perl_av_fetch (my_perl=0x81f5000, av=0x81f734c, key=13,
    lval=1) at av.c:241
#2  0x080b1c30 in Perl_pad_alloc (my_perl=0x81f5000, optype=5, tmptype=512)
    at pad.c:433
#3  0x080af16a in Perl_peep (my_perl=0x81f5000, o=0x820fb4c) at op.c:6789
#4  0x0809fdf8 in Perl_newPROG (my_perl=0x81f5000, o=0x820ff0c) at op.c:1970
#5  0x08098bee in Perl_yyparse (my_perl=0x81f5000) at perly.y:100
#6  0x08064f53 in S_parse_body (my_perl=0x81f5000, env=0x0,
    xsinit=0x805f0ec <xs_init>) at perl.c:2170
#7  0x08063af3 in perl_parse (my_perl=0x81f5000, xsinit=0x805f0ec <xs_init>,
    argc=3, argv=0xbfbfebc0, env=0x0) at perl.c:1555
#8  0x0805f025 in main (argc=3, argv=0xbfbfebc0, env=0xbfbfebd0)
    at perlmain.c:101
(gdb) call Perl_sv_dump(my_perl, (struct sv *) 0x81f5624)
SV = NULL(0x0) at 0x81f5624
  REFCNT = 2147483646
  FLAGS = (PADTMP,READONLY)
(gdb) call Perl_sv_dump(my_perl, (struct sv *) 0x81f7fcc)
SV = NULL(0x0) at 0x81f7fcc
  REFCNT = 1
  FLAGS = ()


What has happened is that the array used for the pad was happily and
accurately storing the value PL_sv_undef, which by now has also (correctly)
acquired the flag PADTMP because in use as a pad temporary. (*This* pad
temporary).

Working back up the last 3 calls of that traceback, pad_alloc does:

	    sv = *av_fetch(PL_comppad, PL_padix, TRUE);
	    if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
		!IS_PADGV(sv) && !IS_PADCONST(sv))
		break;

av_fetch finds the (correct, put there) value PL_sv_undef:

    if (AvARRAY(av)[key] == &PL_sv_undef) {
    emptyness:
	if (lval) {
	    sv = NEWSV(6,0);
	    return av_store(av,key,sv);
	}
	return 0;
    }

and interprets it as an unused array slot. (D'oh!)
So it calls into av_store, to store the value:

    ary[key] = val;

and bang! the correctly stored PL_sv_undef is replaced by a nice new undefined
scalar, which doesn't have PADTMP set, which makes pad_alloc think that the
pad slot is free.


I'm not sure what the solution to this is. I wonder if the cheap hack is
to always "copy" PL_sv_undef into the pad. But long term, should
PL_sv_placeholder be used in place of PL_sv_undef for the AV "not allocated"
marker?

Nicholas Clark

PS TODO item - can that recursive call into av_store be avoided in the common
   case, as I managed for hv_fetch?

• PL_sv_undef in OPCONST in ithreads broken by Nicholas Clark
• Re: PL_sv_undef in OPCONST in ithreads broken by Nicholas Clark