junk and uninit'ed values in tied scalars #8223

p5pRT · 2005-11-23T01:09:34Z

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

Searchable as RT37731$

p5pRT · 2005-11-23T01:09:35Z

From lallip@cs.rpi.edu

Created by lallip@cs.rpi.edu

The following was posted to c.l.p.m on 2005-11-19, by Eric Roode,
who noted that he did not have access to a machine which could run
perlbug. This message is sent on his behalf:

In the past month, three bugs have been reported in my Readonly
module, except that they turned out not to be bugs in the module, but
(sadly) bugs in Perl 5.8. The pure-perl version of Readonly relies
on tied variables, which appear to have various colorful and
intermittent bugs.

Here is a short program that illustrates bug #1:

sub foo::TIESCALAR { bless {value => $_[1]}, $_[0] }
sub foo::FETCH { $_[0]->{value} }
tie my $test, 'foo', 'test';
print "$test$test\n";

This prints "testp\cX\c@" or other similar garbage. The first
interpolation prints fine; the second is reminiscent of a
non-NUL-terminated C string.

Oddly, with a longer string:

sub foo::TIESCALAR { bless {value => $_[1]}, $_[0] }
sub foo::FETCH { $_[0]->{value} }
tie my $test, 'foo', 'I snort the nose, Lucifer!';
print "$test$test\n";

it prints "I snort the nose, Lucifer!I snort the nose, Lucifer!" as
you'd expect. Also, if there is a space, or any other character,
between the two variables in the interpolation:

print "$test $test\n";

there is no buggy behavior.

Here is a short program that illustrates bug #2:

use warnings;
sub foo::TIESCALAR { bless {}, shift }
sub foo::FETCH { return 2 }
tie my $test, 'foo';
my $bits = 3 & ~$test;

This gives the warning
Use of uninitialized value in 1's complement (~) at....

Finally, the mysterious Bug #3:

sub foo::TIESCALAR { bless {value => $_[1]}, $_[0] }
sub foo::FETCH { $_[0]->{value} }
tie my $VAR, 'foo', 'SEARCH';
foreach my $var ($VAR)
{
print +($var eq $VAR) ? 'yes' : 'no';
}

This prints "no".

Amusingly, change the "print" line to:

print +(lc $var eq lc $VAR) ? 'yes' : 'no';

and it prints "yes".

I had several friends try out the code I posted above for "bug
#1". Two people had perl 5.6.1, and that did not exhibit the buggy
behavior. All others had various forms of 5.8.x (where x ranged from
0 to 7), on various platforms (Windows, linux, FreeBSD, MacOSX,
cygwin/2000, cygwin/XP). All 5.8.x users exhibited the buggy
behavior.

Perl Info


Flags:
    category=core
    severity=medium

Site configuration information for perl v5.8.5:

Configured by jon at Tue Jan 11 17:19:41 EST 2005.

Summary of my perl5 (revision 5 version 8 subversion 5) configuration:
  Platform:
    osname=solaris, osvers=2.10, archname=sun4-solaris
    uname='sunos slurm.cs.rpi.edu 5.10 s10_63 sun4u sparc sunw,ultra-5_10 '
    config_args='-d -e -A ldflags=-L/software/perl-5.8.5-0/pkg/lib/5.8.5/sun4-solaris/CORE -R/software/perl-5.8.5-0/pkg/lib/5.8.5/sun4-solaris/CORE -A prefix=/software/perl-5.8.5-0/pkg -A prefixexp=/software/perl-5.8.5-0/pkg -A siteprefix=/usr/local -A siteprefixexp=/usr/local -A d_dosuid=define -A d_mymalloc=undef -A mallocobj= -A mallocsrc= -A usemymalloc=n -A usevendorprefix=define -A vendorprefix=/software/perl-5.8.5-0/pkg -A vendorprefixexp=/software/perl-5.8.5-0/pkg -A installusrbinperl=undef -D useshrplib=true -A cf_email=labstaff@cs.rpi.edu -A perladmin=labstaff@cs.rpi.edu -A installsitearch=/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris -A installsitelib=/usr/local/lib/perl5/site_perl/5.8.5 -A loclibpth=/usr/local/lib -A sitearch=/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris -A sitearchexp=/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris -A sitelib=/usr/local/lib/perl5/site_perl/5.8.5 -A sitelib_stem=/usr/local/lib/perl5/site_perl -A sitelibexp=/usr/local/li!
 b/perl5/site_perl/5.8.5 -D use64bitall=undef -D use64bitint=undef'
    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=undef use64bitall=undef uselongdouble=undef
    usemymalloc=y, bincompat5005=undef
  Compiler:
    cc='cc', ccflags =' -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O',
    cppflags=''
    ccversion='Sun C 5.6 2004/07/15', gccversion='', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/software/perl-5.8.5-0/pkg/lib/5.8.5/sun4-solaris/CORE -R/software/perl-5.8.5-0/pkg/lib/5.8.5/sun4-solaris/CORE -L/usr/lib -L/usr/ccs/lib -L/software/sunone-9.0-0/pkg/prod/lib/v8plus -L/software/sunone-9.0-0/pkg/prod/lib -L/lib -L/usr/local/lib '
    libpth=/usr/lib /usr/ccs/lib /software/sunone-9.0-0/pkg/prod/lib/v8plus /software/sunone-9.0-0/pkg/prod/lib /lib /usr/local/lib
    libs=-lsocket -lnsl -ldl -lm -lc
    perllibs=-lsocket -lnsl -ldl -lm -lc
    libc=/lib/libc.so, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='  -R /software/perl-5.8.5-0/pkg/lib/5.8.5/sun4-solaris/CORE'
    cccdlflags='-KPIC', lddlflags='-G -L/software/perl-5.8.5-0/pkg/lib/5.8.5/sun4-solaris/CORE -R/software/perl-5.8.5-0/pkg/lib/5.8.5/sun4-solaris/CORE -L/usr/lib -L/usr/ccs/lib -L/software/sunone-9.0-0/pkg/prod/lib/v8plus -L/software/sunone-9.0-0/pkg/prod/lib -L/lib -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.8.5:
    /usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/auto/
    /usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/
    /usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/Bundle/
    /cs/lallip/lib/sun4-solaris
    /cs/lallip/lib
    /cs/lallip/lib/perl5/site_perl/5.8.5//sun4-solaris
    /cs/lallip/lib/perl5/site_perl/5.8.5/
    /cs/lallip/lib/perl5/site_perl/5.8.0/sun4-solaris
    /cs/lallip/lib/perl5/site_perl/5.8.0
    /cs/lallip/lib/sun4-solaris
    /software/perl-5.8.5-0/pkg/lib/5.8.5/sun4-solaris
    /software/perl-5.8.5-0/pkg/lib/5.8.5
    /usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris
    /usr/local/lib/perl5/site_perl/5.8.5
    /usr/local/lib/perl5/site_perl
    /software/perl-5.8.5-0/pkg/lib/vendor_perl/5.8.5/sun4-solaris
    /software/perl-5.8.5-0/pkg/lib/vendor_perl/5.8.5
    /software/perl-5.8.5-0/pkg/lib/vendor_perl
    .


Environment for perl v5.8.5:
    HOME=/cs/lallip
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/usr/local/lib/5.8.0/sun4-solaris/CORE/
    LOGDIR (unset)
    PATH=/usr/local/bin:/usr/local/sbin:/usr/openwin/bin:/usr/dt/bin:/usr/bin:/usr/sbin:/bin:/sbin:/usr/ucb:/usr/ccs/bin
    PERL5LIB=/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/auto/:/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/:/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/Bundle/:/cs/lallip/lib:/cs/lallip/lib/perl5/site_perl/5.8.5/:/cs/lallip/lib/perl5/site_perl/5.8.0:/cs/lallip/lib/sun4-solaris
    PERL_BADLANG (unset)
    SHELL=/usr/local/bin/bash

p5pRT · 2005-11-24T03:20:27Z

From @ysth

On Tue, Nov 22, 2005 at 05:09:36PM -0800, lallip @ cs. rpi. edu wrote:

Here is a short program that illustrates bug \#1&#8203;:

    sub foo&#8203;::TIESCALAR \{ bless \{value => $\_\[1\]\}\, $\_\[0\] \}
    sub foo&#8203;::FETCH \{ $\_\[0\]\->\{value\} \}
    tie my $test\, 'foo'\, 'test';
    print "$test$test\\n";
This prints "testp\cX\c@" or other similar garbage. The first
interpolation prints fine; the second is reminiscent of a
non-NUL-terminated C string.

Hmm, does Robin's #26192 fix this, too?

Here is a short program that illustrates bug \#2&#8203;:

    use warnings;
    sub foo&#8203;::TIESCALAR \{ bless \{\}\, shift \}
    sub foo&#8203;::FETCH \{ return 2 \}
    tie my $test\, 'foo';
    my $bits = 3 & ~$test;

This gives the warning
Use of uninitialized value in 1's complement (~) at....

Fixed in blead, probably by #22163, which Nicholas has hesitated to
add to maint.

Finally\, the mysterious Bug \#3&#8203;:

    sub foo&#8203;::TIESCALAR \{ bless \{value => $\_\[1\]\}\, $\_\[0\] \}
    sub foo&#8203;::FETCH \{ $\_\[0\]\->\{value\} \}
    tie my $VAR\, 'foo'\, 'SEARCH';
    foreach my $var \($VAR\)
    \{
       print \+\($var eq $VAR\) ? 'yes' : 'no';
    \}

This prints "no".

Still a problem in blead. I hope any fix to this would make something
that does: sub FETCH { ++$_[0]->{value} } have eq return *false*.

p5pRT · 2005-11-24T03:20:29Z

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

p5pRT · 2005-11-28T09:29:35Z

From @ysth

On Wed, Nov 23, 2005 at 07:17:30PM -0800, Yitzchak Scott-Thoennes wrote:

On Tue, Nov 22, 2005 at 05:09:36PM -0800, lallip @ cs. rpi. edu wrote:
Here is a short program that illustrates bug \#1&#8203;:

    sub foo&#8203;::TIESCALAR \{ bless \{value => $\_\[1\]\}\, $\_\[0\] \}
    sub foo&#8203;::FETCH \{ $\_\[0\]\->\{value\} \}
    tie my $test\, 'foo'\, 'test';
    print "$test$test\\n";
This prints "testp\cX\c@" or other similar garbage. The first
interpolation prints fine; the second is reminiscent of a
non-NUL-terminated C string.
Hmm, does Robin's #26192 fix this, too?

Yes, it does. Thinking ahead to 5.8.9, I'm not sure how well that
plays with the Y2K check that's in pp_concat in maint but not blead,
though. Robin?

Here is a short program that illustrates bug \#2&#8203;:

    use warnings;
    sub foo&#8203;::TIESCALAR \{ bless \{\}\, shift \}
    sub foo&#8203;::FETCH \{ return 2 \}
    tie my $test\, 'foo';
    my $bits = 3 & ~$test;
This gives the warning
Use of uninitialized value in 1's complement (~) at....
Fixed in blead, probably by #22163, which Nicholas has hesitated to
add to maint.

Nope, this was fixed by Rafael's patch #22074; my #22163 was a
followup that eliminated double magic (some introduced by 22074 and
some not, IIRC) and fixed a different problem.

Finally\, the mysterious Bug \#3&#8203;:

    sub foo&#8203;::TIESCALAR \{ bless \{value => $\_\[1\]\}\, $\_\[0\] \}
    sub foo&#8203;::FETCH \{ $\_\[0\]\->\{value\} \}
    tie my $VAR\, 'foo'\, 'SEARCH';
    foreach my $var $$VAR$
    \{
       print \+$$var eq $VAR$ ? 'yes' : 'no';
    \}
This prints "no".
Still a problem in blead. I hope any fix to this would make something
that does: sub FETCH { ++$_[0]->{value} } have eq return *false*.

This does it, if a little heavy-handedly:

Inline Patch

--- perl/sv.c.orig	2005-11-25 09:33:11.000000000 -0800
+++ perl/sv.c	2005-11-27 21:30:09.828265600 -0800
@@ -5579,6 +5579,15 @@ Perl_sv_eq(pTHX_ register SV *sv1, regis
     else
 	pv1 = SvPV_const(sv1, cur1);
 
+    /* if pv1 and pv2 are the same, second SvPV_const call may
+       invalidate pv1, so we may need to make a copy */
+
+    if (sv1 == sv2 && sv1 && (SvTHINKFIRST(sv1) || SvGMAGICAL(sv1))) {
+        sv1 = sv_2mortal(newSVpvn(pv1, cur1));
+        if (SvUTF8(sv2)) SvUTF8_on(sv1);
+        pv1 = SvPV_const(sv1, cur1);
+    }
+
     if (!sv2){
 	pv2 = "";
 	cur2 = 0;

p5pRT · 2005-11-28T12:35:45Z

From robin@cpan.org

On Mon, Nov 28, 2005 at 01:26:31AM -0800, Yitzchak Scott-Thoennes wrote:

Yes, it does. Thinking ahead to 5.8.9, I'm not sure how well that
plays with the Y2K check that's in pp_concat in maint but not blead,
though. Robin?

I've just had a quick look at this, and found that maintperl won't
even compile if you define PERL_Y2KWARN, so I guess this option isn't
too well tested!

Still, it shouldn't be hard to fix that and backport the patch to
maint. I have a version that looks as though it ought to work, and
I'm testing it now.

Robin

p5pRT · 2005-11-28T13:10:34Z

From robin@cpan.org

The below seems okay against 5.8.x.

Robin

Inline Patch

--- pp_hot.c.orig	2005-11-28 13:07:29.000000000 +0000
+++ pp_hot.c	2005-11-28 13:07:38.000000000 +0000
@@ -151,19 +151,22 @@
     dPOPTOPssrl;
     bool lbyte;
     STRLEN rlen;
-    const char *rpv = SvPV_const(right, rlen);	/* mg_get(right) happens here */
-    const bool rbyte = !DO_UTF8(right);
+    const char *lpv = 0, *rpv;
+    bool rbyte;
     bool rcopied = FALSE;
+    STRLEN llen;
 
     if (TARG == right && right != left) {
+	/* mg_get(right) may happen here ... */
+	rpv = SvPV_const(right, rlen);
+	rbyte = !DO_UTF8(right);
 	right = sv_2mortal(newSVpvn(rpv, rlen));
 	rpv = SvPV_const(right, rlen);	/* no point setting UTF-8 here */
 	rcopied = TRUE;
     }
 
     if (TARG != left) {
-        STRLEN llen;
-        const char* const lpv = SvPV_const(left, llen);	/* mg_get(left) may happen here */
+        lpv = SvPV_const(left, llen);	/* mg_get(left) may happen here */
 	lbyte = !DO_UTF8(left);
 	sv_setpvn(TARG, lpv, llen);
 	if (!lbyte)
@@ -172,19 +175,28 @@
 	    SvUTF8_off(TARG);
     }
     else { /* TARG == left */
-        STRLEN llen;
 	if (SvGMAGICAL(left))
 	    mg_get(left);		/* or mg_get(left) may happen here */
-	if (!SvOK(TARG))
+	if (!SvOK(TARG)) {
+	    if (left == right && ckWARN(WARN_UNINITIALIZED))
+		report_uninit();
 	    sv_setpvn(left, "", 0);
+        }
 	(void)SvPV_nomg_const(left, llen);    /* Needed to set UTF8 flag */
 	lbyte = !DO_UTF8(left);
 	if (IN_BYTES)
 	    SvUTF8_off(TARG);
     }
 
+    /* or mg_get(right) may happen here */
+    if (!rcopied) {
+       rpv = SvPV_const(right, rlen);
+       rbyte = !DO_UTF8(right);
+    }
+
 #if defined(PERL_Y2KWARN)
-    if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K) && SvOK(TARG)) {
+    if ((SvIOK(right) || SvNOK(right)) && lpv
+    && ckWARN(WARN_Y2K) && SvOK(TARG)) {
 	if (llen >= 2 && lpv[llen - 2] == '1' && lpv[llen - 1] == '9'
 	    && (llen == 2 || !isDIGIT(lpv[llen - 3])))
 	{
--- t/op/tie.t.orig	2005-11-28 12:56:04.000000000 +0000
+++ t/op/tie.t	2005-11-28 12:57:36.000000000 +0000
@@ -547,3 +547,10 @@
 print $h,"\n";
 EXPECT
 3.3
+########
+sub TIESCALAR { bless {} }
+sub FETCH { shift()->{i} ++ }
+tie $h, "main";
+print $h.$h;
+EXPECT
+01

p5pRT · 2006-08-09T15:49:49Z

From @rgarcia

On 28/11/05, Yitzchak Scott-Thoennes <sthoenna@efn.org> wrote:

Finally\, the mysterious Bug \#3&#8203;:

    sub foo&#8203;::TIESCALAR \{ bless \{value => $\_\[1\]\}\, $\_\[0\] \}
    sub foo&#8203;::FETCH \{ $\_\[0\]\->\{value\} \}
    tie my $VAR\, 'foo'\, 'SEARCH';
    foreach my $var $$VAR$
    \{
       print \+$$var eq $VAR$ ? 'yes' : 'no';
    \}
This prints "no".
Still a problem in blead. I hope any fix to this would make something
that does: sub FETCH { ++$_[0]->{value} } have eq return *false*.
This does it, if a little heavy-handedly:

Thanks, applied as change #28684 (I added a regression test.)

--- perl/sv.c.orig 2005-11-25 09:33:11.000000000 -0800
+++ perl/sv.c 2005-11-27 21:30:09.828265600 -0800
@@ -5579,6 +5579,15 @@ Perl_sv_eq(pTHX_ register SV *sv1, regis
else
pv1 = SvPV_const(sv1, cur1);

+ /* if pv1 and pv2 are the same, second SvPV_const call may
+ invalidate pv1, so we may need to make a copy */
+
+ if (sv1 == sv2 && sv1 && (SvTHINKFIRST(sv1) || SvGMAGICAL(sv1))) {
+ sv1 = sv_2mortal(newSVpvn(pv1, cur1));
+ if (SvUTF8(sv2)) SvUTF8_on(sv1);
+ pv1 = SvPV_const(sv1, cur1);
+ }
+
if (!sv2){
pv2 = "";
cur2 = 0;

p5pRT · 2006-08-09T15:50:22Z

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

p5pRT closed this as completed Aug 9, 2006

p5pRT added Severity Medium distro-Solaris type-core labels Oct 18, 2019

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

junk and uninit'ed values in tied scalars #8223

junk and uninit'ed values in tied scalars #8223

p5pRT commented Nov 23, 2005

p5pRT commented Nov 23, 2005

p5pRT commented Nov 24, 2005

p5pRT commented Nov 24, 2005

p5pRT commented Nov 28, 2005

p5pRT commented Nov 28, 2005

p5pRT commented Nov 28, 2005

p5pRT commented Aug 9, 2006

p5pRT commented Aug 9, 2006

junk and uninit'ed values in tied scalars #8223

junk and uninit'ed values in tied scalars #8223

Comments

p5pRT commented Nov 23, 2005

p5pRT commented Nov 23, 2005

From lallip@cs.rpi.edu

Created by lallip@cs.rpi.edu

p5pRT commented Nov 24, 2005

From @ysth

p5pRT commented Nov 24, 2005

p5pRT commented Nov 28, 2005

From @ysth

p5pRT commented Nov 28, 2005

From robin@cpan.org

p5pRT commented Nov 28, 2005

From robin@cpan.org

p5pRT commented Aug 9, 2006

From @rgarcia

p5pRT commented Aug 9, 2006