Empty tied hash delete in scalar context seems to pick up random trash from the stack #7265

p5pRT · 2004-04-24T10:31:07Z

Migrated from rt.perl.org#29127 (status was 'resolved')

Searchable as RT29127$

p5pRT · 2004-04-24T10:31:07Z

From perl-5.8.0@ton.iguana.be

Created by perl-5.8.0@ton.iguana.be

#! /usr/bin/perl -wl

sub TIEHASH {
return bless {};
}

my $tie = tie my %cache, "main";
print "foo=" . delete @cache{()};
print scalar delete @cache{()} for "bar";

This will print:
foo=foo=
bar

The first print seems to pick up the "foo=" that's pending and prints
that as result of the delete. The second print seems to pick up $_

Perl Info


Flags:
    category=core
    severity=low

Site configuration information for perl v5.8.2:

Configured by ton at Sun Jan  4 19:19:06 CET 2004.

Summary of my perl5 (revision 5.0 version 8 subversion 2) configuration:
  Platform:
    osname=linux, osvers=2.6.0, archname=i686-linux-64int-ld
    uname='linux quasar 2.6.0 #3 thu dec 18 18:22:48 cet 2003 i686 gnulinux '
    config_args=''
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=define use64bitall=undef uselongdouble=define
    usemymalloc=y, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2 -fomit-frame-pointer',
    cppflags='-fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='3.4.0 20031231 (experimental)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long long', ivsize=8, nvtype='long double', nvsize=12, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -ldb -ldl -lm -lcrypt -lutil -lc
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
    libc=/lib/libc-2.3.2.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.3.2'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:



@INC for perl v5.8.2:
    /usr/lib/perl5/5.8.2/i686-linux-64int-ld
    /usr/lib/perl5/5.8.2
    /usr/lib/perl5/site_perl/5.8.2/i686-linux-64int-ld
    /usr/lib/perl5/site_perl/5.8.2
    /usr/lib/perl5/site_perl
    .


Environment for perl v5.8.2:
    HOME=/home/ton
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/ton/bin.Linux:/home/ton/bin:/home/ton/bin.SampleSetup:/usr/local/bin:/usr/local/sbin:/usr/local/jre/bin:/home/oracle/product/9.0.1/bin:/usr/local/ar/bin:/usr/games/bin:/usr/X11R6/bin:/usr/share/bin:/usr/bin:/usr/sbin:/bin:/sbin:.
    PERL_BADLANG (unset)
    SHELL=/bin/bash

p5pRT · 2004-04-28T13:55:41Z

From perl5-porters@ton.iguana.be

In article <rt-3.0.8-29127-86013.2.58320876738814@perl.org>,
"perl-5.8.0@ton.iguana.be (via RT)" <perlbug-followup@perl.org> writes:

# New Ticket Created by perl-5.8.0@ton.iguana.be
# Please include the string: [perl #29127]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org:80/rt3/Ticket/Display.html?id=29127 >

This is a bug report for perl from perl-5.8.0@ton.iguana.be,
generated with the help of perlbug 1.34 running under perl v5.8.2.

-----------------------------------------------------------------
[Please enter your report here]

#! /usr/bin/perl -wl

sub TIEHASH {
return bless {};
}

my $tie = tie my %cache, "main";
print "foo=" . delete @cache{()};
print scalar delete @cache{()} for "bar";

This will print:
foo=foo=
bar

The first print seems to pick up the "foo=" that's pending and prints
that as result of the delete. The second print seems to pick up $_

The tie is a red herring. It happens like this too:

#! /usr/bin/perl -wl
print "foo=" . delete @cache{()};
print scalar delete @cache{()} for "bar";

p5pRT · 2004-04-28T13:55:43Z

The RT System itself - Status changed from 'new' to 'open'

p5pRT · 2004-05-03T19:15:00Z

From @iabyn

On Wed, Apr 28, 2004 at 01:54:12PM +0000, Ton Hospel wrote:

The tie is a red herring. It happens like this too:

#! /usr/bin/perl -wl
print "foo=" . delete @cache{()};
print scalar delete @cache{()} for "bar";

fixed in belldperl by the change below.

Dave.

--
You live and learn (although usually you just live).

Change 22775 by davem@davem-percy on 2004/05/03 18:52:39

[perl #29127] scalar delete of empty slice returned garbage

Affected files ...

... //depot/perl/pp.c#415 edit
... //depot/perl/t/op/delete.t#9 edit

Differences ...

==== //depot/perl/pp.c#415 (text) ====

@@ -3795,7 +3795,10 @@
SP = ORIGMARK;
else if (gimme == G_SCALAR) {
MARK = ORIGMARK;
- *++MARK = *SP;
+ if (SP > MARK)
+ *++MARK = *SP;
+ else
+ *++MARK = &PL_sv_undef;
SP = MARK;
}
}

==== //depot/perl/t/op/delete.t#9 (xtext) ====

@@ -1,6 +1,6 @@
#!./perl

-print "1..36\n";
+print "1..37\n";

# delete() on hash elements

@@ -121,3 +121,11 @@
print "not " unless $a == $b && $b == $c;
print "ok 36\n";
}
+
+{
+ # [perl #29127] scalar delete of empty slice returned garbage
+ my %h;
+ my ($x,$y) = (1, scalar delete @h{()});
+ print "not " if defined $y;
+ print "ok 37\n";
+}

p5pRT · 2004-05-03T19:50:58Z

@iabyn - Status changed from 'open' to 'resolved'

p5pRT · 2004-05-05T02:31:37Z

From @davidnicol

How do we feel about the conditional operator?

the ternary conditional operator would make the patch smaller

MARK = ORIGMARK;
- *++MARK = *SP;
+ *++MARK = SP > MARK ? *SP : &PL_sv_undef;
SP = MARK;

for that matter, I've written a patch generator -- running
it against all the .c files in the 5.8.4 release
saves, err, thirty lines in five files. And probably makes
it harder to read for people who don't like the conditional
operator. Or maybe it gives warm feelings to people who
like using the conditional operator for rvalues. I don't know.

Attached: the file patcher tool and the resulting diff
against a very recent download from
rsync rsync://ftp.linux.activestate.com/perl-current/ .

Dave Mitchell wrote:

@@ -3795,7 +3795,10 @@
SP = ORIGMARK;
else if (gimme == G_SCALAR) {
MARK = ORIGMARK;
- *++MARK = *SP;
+ if (SP > MARK)
+ *++MARK = *SP;
+ else
+ *++MARK = &PL_sv_undef;
SP = MARK;
}
}

--
davidnicol@pay2send.com.
I know you, junk mail. Gonna miss you when you're gone

p5pRT · 2004-05-05T02:31:37Z

From @davidnicol

find_simple_ifsCURRENT.diff

diff -ru CURRENT/op.c perl-5.8.4-opt/op.c
--- CURRENT/op.c	2004-05-04 14:43:26.000000000 -0500
+++ perl-5.8.4-opt/op.c	2004-05-04 21:21:18.000000000 -0500
@@ -2445,10 +2445,7 @@
 	    tdiff = tlast - tfirst;
 	    rdiff = rlast - rfirst;
 
-	    if (tdiff <= rdiff)
-		diff = tdiff;
-	    else
-		diff = rdiff;
+	    diff = tdiff <= rdiff ? tdiff : rdiff;
 
 	    if (rfirst == 0xffffffff) {
 		diff = tdiff;	/* oops, pretend rdiff is infinite */
@@ -2483,10 +2480,7 @@
 
 	if (max > 0xffff)
 	    bits = 32;
-	else if (max > 0xff)
-	    bits = 16;
-	else
-	    bits = 8;
+	else bits = max > 0xff ? 16 : 8;
 
 	Safefree(cPVOPo->op_pv);
 	cSVOPo->op_sv = (SV*)swash_init("utf8", "", listsv, bits, none);
@@ -3352,10 +3346,7 @@
     /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
     if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
 	if (type == OP_AND || type == OP_OR) {
-	    if (type == OP_AND)
-		type = OP_OR;
-	    else
-		type = OP_AND;
+	    type = type == OP_AND ? OP_OR : OP_AND;
 	    o = first;
 	    first = *firstp = cUNOPo->op_first;
 	    if (o->op_next)
diff -ru CURRENT/os2/os2.c perl-5.8.4-opt/os2/os2.c
--- CURRENT/os2/os2.c	2004-01-01 11:50:50.000000000 -0600
+++ perl-5.8.4-opt/os2/os2.c	2004-05-04 21:21:17.000000000 -0500
@@ -3567,10 +3567,7 @@
 	return Perl_rc;
     if (type > 0)
 	what = END_LIBPATH;
-    else if (type == 0)
-	what = BEGIN_LIBPATH;
-    else
-	what = LIBPATHSTRICT;
+    else what = type == 0 ? BEGIN_LIBPATH : LIBPATHSTRICT;
     return (*(PELP)f)(path, what);
 }
 
diff -ru CURRENT/pp.c perl-5.8.4-opt/pp.c
--- CURRENT/pp.c	2004-05-03 14:17:25.000000000 -0500
+++ perl-5.8.4-opt/pp.c	2004-05-04 21:21:18.000000000 -0500
@@ -3795,10 +3795,7 @@
 	    SP = ORIGMARK;
 	else if (gimme == G_SCALAR) {
 	    MARK = ORIGMARK;
-	    if (SP > MARK)
-		*++MARK = *SP;
-	    else
-		*++MARK = &PL_sv_undef;
+	    *++MARK = SP > MARK ? *SP : &PL_sv_undef;
 	    SP = MARK;
 	}
     }
diff -ru CURRENT/pp_hot.c perl-5.8.4-opt/pp_hot.c
--- CURRENT/pp_hot.c	2004-04-23 16:05:07.000000000 -0500
+++ perl-5.8.4-opt/pp_hot.c	2004-05-04 21:21:18.000000000 -0500
@@ -1891,10 +1891,7 @@
 
     if (SvMAGICAL(av) || AvREIFY(av)) {
 	SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
-	if (svp)
-	    sv = *svp;
-	else
-	    sv = Nullsv;
+	sv = svp ? *svp : Nullsv;
     }
     else {
 	sv = AvARRAY(av)[++cx->blk_loop.iterix];
diff -ru CURRENT/pp_sys.c perl-5.8.4-opt/pp_sys.c
--- CURRENT/pp_sys.c	2004-03-16 12:42:23.000000000 -0600
+++ perl-5.8.4-opt/pp_sys.c	2004-05-04 21:21:18.000000000 -0500
@@ -1511,10 +1511,7 @@
     STRLEN len;
     int mode, perm;
 
-    if (MAXARG > 3)
-	perm = POPi;
-    else
-	perm = 0666;
+    perm = MAXARG > 3 ? POPi : 0666;
     mode = POPi;
     sv = POPs;
     gv = (GV *)POPs;
@@ -3512,10 +3509,7 @@
     SV **svp;
     STRLEN n_a;
 
-    if( MAXARG == 1 )
-        tmps = POPpx;
-    else
-        tmps = 0;
+    tmps =  MAXARG == 1  ? POPpx : 0;
 
     if( !tmps || !*tmps ) {
         if (    (svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE))
@@ -3805,10 +3799,7 @@
     char *tmps;
     bool copy = FALSE;
 
-    if (MAXARG > 1)
-	mode = POPi;
-    else
-	mode = 0777;
+    mode = MAXARG > 1 ? POPi : 0777;
 
     TRIMSLASHES(tmps,len,copy);
 
diff -ru CURRENT/regcomp.c perl-5.8.4-opt/regcomp.c
--- CURRENT/regcomp.c	2004-04-19 03:55:17.000000000 -0500
+++ perl-5.8.4-opt/regcomp.c	2004-05-04 21:21:19.000000000 -0500
@@ -1916,10 +1916,7 @@
 	    /* turn .* into ^.* with an implied $*=1 */
 	    int type = OP(NEXTOPER(first));
 
-	    if (type == REG_ANY)
-		type = ROPT_ANCH_MBOL;
-	    else
-		type = ROPT_ANCH_SBOL;
+	    type = type == REG_ANY ? ROPT_ANCH_MBOL : ROPT_ANCH_SBOL;
 
 	    r->reganch |= type | ROPT_IMPLICIT;
 	    first = NEXTOPER(first);

p5pRT · 2004-05-05T02:31:37Z

From @davidnicol

find_simple_ifs.pl

p5pRT · 2004-05-05T08:34:20Z

From @pjcj

On Tue, May 04, 2004 at 09:31:12PM -0500, David Nicol wrote:

How do we feel about the conditional operator?

the ternary conditional operator would make the patch smaller
MARK = ORIGMARK;
- *++MARK = *SP;
+ *++MARK = SP > MARK ? *SP : &PL_sv_undef;
SP = MARK;

Looks like undefined behaviour to me.

--
Paul Johnson - paul@pjcj.net
http://www.pjcj.net

p5pRT closed this as completed May 3, 2004

p5pRT added Severity Low distro-Linux type-core labels Oct 18, 2019

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Empty tied hash delete in scalar context seems to pick up random trash from the stack #7265

Empty tied hash delete in scalar context seems to pick up random trash from the stack #7265

p5pRT commented Apr 24, 2004

p5pRT commented Apr 24, 2004

p5pRT commented Apr 28, 2004

p5pRT commented Apr 28, 2004

p5pRT commented May 3, 2004

p5pRT commented May 3, 2004

p5pRT commented May 5, 2004

p5pRT commented May 5, 2004

p5pRT commented May 5, 2004

p5pRT commented May 5, 2004

Empty tied hash delete in scalar context seems to pick up random trash from the stack #7265

Empty tied hash delete in scalar context seems to pick up random trash from the stack #7265

Comments

p5pRT commented Apr 24, 2004

p5pRT commented Apr 24, 2004

From perl-5.8.0@ton.iguana.be

Created by perl-5.8.0@ton.iguana.be

p5pRT commented Apr 28, 2004

From perl5-porters@ton.iguana.be

p5pRT commented Apr 28, 2004

p5pRT commented May 3, 2004

From @iabyn

p5pRT commented May 3, 2004

p5pRT commented May 5, 2004

From @davidnicol

p5pRT commented May 5, 2004

From @davidnicol

p5pRT commented May 5, 2004

From @davidnicol

p5pRT commented May 5, 2004

From @pjcj