develooper Front page | perl.perl5.porters | Postings from May 2002

[ID 20020525.002] coredump/bad free warning in blead with SIGWARN

From:
Nicholas Clark
Date:
May 25, 2002 16:27
Subject:
[ID 20020525.002] coredump/bad free warning in blead with SIGWARN
Message ID:
20020525232331.GC3910@Bagpuss.unfortu.net
This is a bug report for perl from nick@ccl4.org,
generated with the help of perlbug 1.33 running under perl v5.7.3.


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

I've managed to do something evil to bleadperl (this is patch 16767)
Segmentation fault (core dumped)

(gdb) where
#0  0x80a177a in S_new_xrv ()
#1  0x80a1fe5 in Perl_sv_upgrade ()
#2  0x80a4dc2 in Perl_sv_setsv_flags ()
#3  0x809abfe in Perl_pp_sassign ()
#4  0x809a8d0 in Perl_runops_standard ()
#5  0x805eace in S_call_body ()
#6  0x805e8b2 in Perl_call_sv ()
#7  0x8061322 in S_call_list_body ()
#8  0x8061030 in Perl_call_list ()
#9  0x805c4a7 in perl_destruct ()
#10 0x805b920 in main ()
#11 0x805b7fd in _start ()

It's a bit late, and I've not done too well at pruning the test case
because I need to go to bed. The simpler version is this:

#!./perl -w

my @warnings;
sub BEGIN {
    $SIG{__WARN__} = sub {
        push @warnings, $_[0];
        print STDERR $_[0];
    };
}

use strict;

BEGIN {
    push @warnings, \'Storable::FOO';
}
$Storable::FOO = 1;

print "'$_'\n", @warnings;

my $unexpected = 0;
while (@warnings and my $instruction = shift @warnings) {
    $instruction = $$instruction;
    warn $instruction;
    my ($expect, $got);
    if ($instruction =~ /^!(.*)/) {
        # Don't expect to see a warning for this variable.
        # So should either be at the end, or next item is another instruction.
    } else {
        # Expect a used only once warning.
        $expect = "/^Name \"$instruction\" used only once/";
    }

    if (@warnings and ref $warnings[0]) {
        # Something not an instruction follows us.
        $got = shift @warnings;
        # Clear any extra unexpected warnings.
        while (@warnings and !ref $warnings[0]) {
            shift @warnings;
            $unexpected++;
        }
    }
}
__END__

On FreeBSD that gives this slew of warnings, most of which are expected:

Name "Storable::FOO" used only once: possible typo at /home/nick/test/CorePerl line 16.
Use of uninitialized value in concatenation (.) or string at /home/nick/test/CorePerl line 18.
''
SCALAR(0x8123d44)Name "Storable::FOO" used only once: possible typo at /home/nick/test/CorePerl line 16.
Use of uninitialized value in concatenation (.) or string at /home/nick/test/CorePerl line 18.
Use of uninitialized value in warn at /home/nick/test/CorePerl line 23.
Warning: something's wrong at /home/nick/test/CorePerl line 23.
Use of uninitialized value in pattern match (m//) at /home/nick/test/CorePerl line 25.
Use of uninitialized value in concatenation (.) or string at /home/nick/test/CorePerl line 30.
perl16767-32 in free(): warning: modified (chunk-) pointer
Can't use string ("Name "Storable::FOO" used only o") as a SCALAR ref while "strict refs" in use at /home/nick/test/CorePerl line 22.

BUT NOT THAT ONE:
perl16767-32 in free(): warning: modified (chunk-) pointer

Something is scribbling on RAM. The original program gave this:


1..2
ok 1 - No warnings before we start
Use of uninitialized value in pattern match (m//) at t/variables.t line 73.
Use of uninitialized value in concatenation (.) or string at t/variables.t line 78.
Use of uninitialized value in concatenation (.) or string at t/variables.t line 92.
not ok 2 - Should be a warning for 
#     Failed test (t/variables.t at line 90)
#                   'SCALAR(0x8119fcc)'
#     doesn't match '/^Name "" used only once/'
Can't use string ("Use of uninitialized value in co") as a SCALAR ref while "strict refs" in use at t/variables.t line 71.
Segmentation fault (core dumped)


I can't see why the logic should end up with me attempting to dereferencing
a non-reference. Or why the string has been truncated, although that looks
like it's a side effect of RAM scribbling.

The original program is somewhat longer. I include it, because it does
SEGV for me, whereas my cutdown version does not.

#!./perl -w

#
#  Copyright 2002, Larry Wall.
#
#  You may redistribute only under the same terms as Perl 5, as specified
#  in the README file that comes with the distribution.
#

# I ought to keep this test easily backwards compatible to 5.004, so no
# qr//;

# This test checks downgrade behaviour on pre-5.8 perls when new 5.8 features
# are encountered.

# This might be rather sick way of doing things, but it should work without
# spawning a new perl.

# Array accumulates things we're trying (as refs to scalar), interspersed with
# warnings seen.

my @warnings;
sub BEGIN {
    if ($ENV{PERL_CORE}){
	chdir('t') if -d 't';
	@INC = ('.', '../lib');
    } else {
	unshift @INC, 't';
    }
    require Config; import Config;
    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
        print "1..0 # Skip: Storable was not built\n";
        exit 0;
    }
    $SIG{__WARN__} = sub {
        push @warnings, $_[0];
        print STDERR $_[0]
            unless $_[0] =~ /^Name "Storable::[a-zA-Z_]+" used only once/;
    };
}

use Test::More tests => 2;
use Storable;
use strict;

BEGIN {
    push @warnings, \'Storable::FOO';
}
$Storable::FOO = 1;

# The idea is that we don't have DEBUGME enabled on shipping code.
BEGIN {
    push @warnings, \'Storable::DEBUGME'; # Grr'
}
$Storable::DEBUGME = 1;


# Coredump (no change actually) with our without this one:
delete $SIG{__WARN__};

# Now eat our warnings.
my $early = 0;
while (!ref $warnings[0]) {
    shift @warnings;
    $early++;
}
is ($early, 0, "No warnings before we start");

my $unexpected = 0;
while (@warnings and my $instruction = shift @warnings) {
    $instruction = $$instruction;
    my ($expect, $got);
    if ($instruction =~ /^!(.*)/) {
        # Don't expect to see a warning for this variable.
        # So should either be at the end, or next item is another instruction.
    } else {
        # Expect a used only once warning.
        $expect = "/^Name \"$instruction\" used only once/";
    }

    if (@warnings and ref $warnings[0]) {
        # Something not an instruction follows us.
        $got = shift @warnings;
        # Clear any extra unexpected warnings.
        while (@warnings and !ref $warnings[0]) {
            shift @warnings;
            $unexpected++;
        }
    }
    if ($expect) {
        # expecting a warning.
        like ($got, $expect, "Should be a warning for $instruction");
    } else {
        is ($got, $expect, "Should be no warning for $1");
    }
}

is ($unexpected, 0, "No unexpected warnings");
__END__

Hopefully someone in a more appropriate timezone who isn't going out tomorrow
can cut this down to a terse coredump, or better still patch it.

Bug seems to be present in 5.6.1, 5.6.0, 5.005_03 and 5.004_05 too,
although 5.6.0 isn't showing the warning from FreeBSD malloc about
modified (chunk-) pointer

Nicholas Clark

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=low
---
This perlbug was built using Perl v5.7.3 - Sat May 25 15:42:18 BST 2002
It is being executed now by  Perl v5.7.3 - Fri May 24 21:02:00 BST 2002.

Site configuration information for perl v5.7.3:

Configured by nick at Fri May 24 21:02:00 BST 2002.

Summary of my perl5 (revision 5.0 version 7 subversion 3 patch 16767) configuration:
  Platform:
    osname=freebsd, osvers=4.5-stable, archname=i386-freebsd
    uname='freebsd thinking-cap.moo 4.5-stable freebsd 4.5-stable #1: wed feb 6 16:15:14 gmt 2002 nick@thinking-cap.moo:stuffusrsrcsyscompilethinkingcap i386 '
    config_args='-de -Dcc=ccache gcc -Dld=gcc -Dusedevel -Ubincompat5005 -Doptimize=-Os -Uinstallusrbinperl -Dcf_email=nick@ccl4.org -Dperladmin=nick@ccl4.org -Dinc_version_list=  -Dinc_version_list_init=0 -Dinstallman1dir=none -Dinstallman3dir=none'
    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=n, bincompat5005=undef
  Compiler:
    cc='ccache gcc', ccflags ='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -I/usr/local/include',
    optimize='-Os',
    cppflags='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='2.95.3 20010315 (release) [FreeBSD]', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags ='-Wl,-E  -L/usr/local/lib'
    libpth=/usr/lib /usr/local/lib
    libs=-lm -lc -lcrypt -lutil
    perllibs=-lm -lc -lcrypt -lutil
    libc=, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
    cccdlflags='-DPIC -fpic', lddlflags='-shared  -L/usr/local/lib'

Locally applied patches:
    DEVEL16763

---
@INC for perl v5.7.3:
    /usr/local/lib/perl5/5.7.3/i386-freebsd
    /usr/local/lib/perl5/5.7.3
    /usr/local/lib/perl5/site_perl/5.7.3/i386-freebsd
    /usr/local/lib/perl5/site_perl/5.7.3
    /usr/local/lib/perl5/site_perl
    .

---
Environment for perl v5.7.3:
    HOME=/home/nick
    LANG (unset)
    LANGUAGE (unset)
    LC_CTYPE=en_GB.ISO_8859-1
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/nick/bin:/sbin:/bin:/usr/sbin:/usr/bin:/usr/games:/usr/local/sbin:/usr/local/bin:/usr/X11R6/bin:/home/nick/bin:/sbin:/usr/sbin:/usr/local/sbin
    PERL_BADLANG (unset)
    SHELL=/usr/local/bin/bash
Reply-To: 




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About