p5pRT
commented
22 years ago From @nwc10
Created by @nwc10
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
Migrated from rt.perl.org#9394 (status was 'resolved')
Searchable as RT9394$