Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Benchmark.pm cmpthese segfault #6892

Closed
p5pRT opened this issue Nov 3, 2003 · 8 comments
Closed

Benchmark.pm cmpthese segfault #6892

p5pRT opened this issue Nov 3, 2003 · 8 comments

Comments

@p5pRT
Copy link

p5pRT commented Nov 3, 2003

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

Searchable as RT24398$

@p5pRT
Copy link
Author

p5pRT commented Nov 3, 2003

From mjp-perl-ZYsBlwkHGFY@pilcrow.madison.wi.us

Created by mjp@box.securepipe.com

Empty hashref to Benchmark​::cmpthese gives segfault.

  $ ./perl-5.8.2-RC1 -MBenchmark=​:all -e 'cmpthese(10, {})'
  Segmentation fault

  $ ./perl-5.8.2-RC1 -MBenchmark=​:all -e 'cmpthese(timethese(1, {}))'
  Benchmark​: timing 1 iterations of ...
  Segmentation fault

Also observed under 5.8.1.

Perl Info

Flags:
    category=library
    severity=low

Site configuration information for perl v5.8.2:

Configured by mjp at Thu Oct 30 23:01:34 CST 2003.

Summary of my perl5 (revision 5.0 version 8 subversion 2) configuration:
  Platform:
    osname=linux, osvers=2.4.20-19.7, archname=i686-linux-thread-multi
    uname='linux box.securepipe.com 2.4.20-19.7 #1 tue jul 15 13:44:14 edt 2003 i686 unknown '
    config_args='-def config.sh'
    hint=previous, useposix=true, d_sigaction=define
    usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm',
    optimize='-O2',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -fno-strict-aliasing -I/usr/local/include -I/usr/include/gdbm -D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm -D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm'
    ccversion='', gccversion='2.96 20000731 (Red Hat Linux 7.3 2.96-113)', 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='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -lndbm -lgdbm -ldl -lm -lcrypt -lutil -lpthread -lc
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    libc=/lib/libc-2.2.5.so, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version='2.2.5'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic -Wl,-rpath,/usr/local/lib/perl5/5.8.1/i686-linux-thread-multi/CORE'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    RC1


@INC for perl v5.8.2:
    /home/mjp/tmp/perl-5.8.2-RC1/lib
    /usr/local/lib/perl5/5.8.1/i686-linux-thread-multi
    /usr/local/lib/perl5/5.8.1
    /usr/local/lib/perl5/site_perl/5.8.1/i686-linux-thread-multi
    /usr/local/lib/perl5/site_perl/5.8.1
    /usr/local/lib/perl5/site_perl/5.8.1
    .


Environment for perl v5.8.2:
    HOME=/home/mjp
    LANG=en_US.iso885915
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/home/mjp/tmp/perl-5.8.2-RC1
    LOGDIR (unset)
    PATH=/home/mjp/opt/bin:/usr/local/bin:/bin:/usr/bin:/usr/X11R6/bin:/home/mjp/bin
    PERL5LIB=/home/mjp/tmp/perl-5.8.2-RC1/lib:
    PERL_BADLANG (unset)
    SHELL=/bin/bash

@p5pRT
Copy link
Author

p5pRT commented Nov 5, 2003

From stas@stason.org

mjp-perl-ZYsBlwkHGFY@​pilcrow.madison.wi.us (via RT) wrote​:

# New Ticket Created by mjp-perl-ZYsBlwkHGFY@​pilcrow.madison.wi.us
# Please include the string​: [perl #24398]
# in the subject line of all future correspondence about this issue.
# <URL​: http​://rt.perl.org/rt2/Ticket/Display.html?id=24398 >

This is a bug report for perl from mjp@​box.securepipe.com,
generated with the help of perlbug 1.34 running under perl v5.8.2.

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

Empty hashref to Benchmark​::cmpthese gives segfault.

$ ./perl-5.8.2-RC1 -MBenchmark=​:all -e 'cmpthese(10, {})'
Segmentation fault

$ ./perl-5.8.2-RC1 -MBenchmark=​:all -e 'cmpthese(timethese(1, {}))'
Benchmark​: timing 1 iterations of ...
Segmentation fault

Also observed under 5.8.1.

Here is the "fix" that prevent the segfault conditions. Though there is more
problems with Benchmarks.pm which need to be fixed. Next we look at the
segfault itself.

Inline Patch
--- Benchmark.pm.orig   2003-11-05 00:36:58.000000000 -0800
+++ Benchmark.pm        2003-11-05 00:38:26.000000000 -0800
@@ -890,7 +890,7 @@
      @vals = sort { $a->[7] <=> $b->[7] } @vals;

      # If more than half of the rates are greater than one...
-    my $display_as_rate = $vals[$#vals>>1]->[7] > 1;
+    my $display_as_rate = @vals ? ($vals[$#vals>>1]->[7] > 1) : 0;

      my @rows;
      my @col_widths;

What we get here is $vals[$#vals>>1], where $#vals returns -1, -1>>1 gives us 2147483647 \(notice that this is I32\_MAX\)\, internally we get $vals\[2147483647\] calling Perl\_pp\_aelem\, calling Perl\_av\_fetch which tries to store it via Perl\_av\_store eventually segfaulting in Perl\_av\_extend trying to blow up the array to I32\_MAX elements on line​:

av.c​:
  157 while (tmp)
=> 158 ary[--tmp] = &PL_sv_undef;
  159 }

The segfault conditions are easy to reproduce outside the reported one liner​:

% perl-5.8.2-ithread -le '@​a; $a[2**31-1] = 5'
boom, crash, segfault

so it does with 2**30-1 and so with 2*29, the only successful one was​:

perl-5.8.2-ithread -le '@​a; $a[2**27-1] = 5' which almost ate all my memory
and swap (about 1300M total). I'm not sure what's the right fix, but most
likely Perl_av_extend shouldn't allow keys which are too big. Dunno what's the
definition of big is acceptible.

I think it's really malloc that fails, but the if you look at the core file
it's totally blown up

(gdb) where
#0 0x400abcd2 in ?? ()
#1 0x400ac4de in ?? ()
#2 0x400ac062 in ?? ()
#3 0x400ba823 in ?? ()
#4 0x40094e6e in ?? ()
#5 0x4003a9d6 in ?? ()
#6 0x4003a418 in ?? ()
#7 0x0804947e in main (argc=4, argv=0xbffff4d4, env=0xbffff4e8)
  at perlmain.c​:86
#8 0x40258c57 in ?? ()

Luckily interactive debugging was much more to the point. And the gdb macro​:

define curinfo
  printf "%d​:%s\n", my_perl->Tcurcop->cop_line, my_perl->Tcurcop->cop_file
end

has shown me where in the perl code the problem comes from.

__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http​://stason.org/ mod_perl Guide ---> http​://perl.apache.org
mailto​:stas@​stason.org http​://use.perl.org http​://apacheweek.com
http​://modperlbook.org http​://apache.org http​://ticketmaster.com

@p5pRT
Copy link
Author

p5pRT commented Nov 5, 2003

From @schwern

On Wed, Nov 05, 2003 at 12​:50​:25AM -0800, Stas Bekman wrote​:

Here is the "fix" that prevent the segfault conditions. Though there is
more problems with Benchmarks.pm which need to be fixed. Next we look at
the segfault itself.

--- Benchmark.pm.orig 2003-11-05 00​:36​:58.000000000 -0800
+++ Benchmark.pm 2003-11-05 00​:38​:26.000000000 -0800
@​@​ -890,7 +890,7 @​@​
@​vals = sort { $a->[7] <=> $b->[7] } @​vals;

 \# If more than half of the rates are greater than one\.\.\.

- my $display_as_rate = $vals[$#vals>>1]->[7] > 1;
+ my $display_as_rate = @​vals ? ($vals[$#vals>>1]->[7] > 1) : 0;

Since $foo>>1 is just an clever way to say int $foo/2, but in an alien
tongue, that should probably just be​:

  my $display_as_rate = $vals[$#vals/2]->[7] > 1;

no?

--
Michael G Schwern schwern@​pobox.com http​://www.pobox.com/~schwern/
<mendel> ScHWeRnsChweRN sChWErN SchweRN SCHWErNSChwERnsCHwERN
  sChWErn ScHWeRn schweRn sCHWErN schWeRn scHWeRN
  SchWeRN scHWErn SchwErn scHWErn ScHweRN sChwern
scHWerN scHWeRn scHWerN ScHwerN SChWeRN scHWeRn
  SchwERNschwERn SCHwern sCHWErN SCHWErN sChWeRn

@p5pRT
Copy link
Author

p5pRT commented Nov 5, 2003

From stas@stason.org

Michael G Schwern wrote​:

On Wed, Nov 05, 2003 at 12​:50​:25AM -0800, Stas Bekman wrote​:

Here is the "fix" that prevent the segfault conditions. Though there is
more problems with Benchmarks.pm which need to be fixed. Next we look at
the segfault itself.

--- Benchmark.pm.orig 2003-11-05 00​:36​:58.000000000 -0800
+++ Benchmark.pm 2003-11-05 00​:38​:26.000000000 -0800
@​@​ -890,7 +890,7 @​@​
@​vals = sort { $a->[7] <=> $b->[7] } @​vals;

\# If more than half of the rates are greater than one\.\.\.

- my $display_as_rate = $vals[$#vals>>1]->[7] > 1;
+ my $display_as_rate = @​vals ? ($vals[$#vals>>1]->[7] > 1) : 0;

Since $foo>>1 is just an clever way to say int $foo/2, but in an alien
tongue, that should probably just be​:

my $display\_as\_rate = $vals\[$\#vals/2\]\->\[7\] > 1;

no?

  $vals[-1/2] == $vals[0], is wrong in any case, since @​vals == 0;

I wonder why​:

% perl -le '@​a; print $#a'
-1

Shouldn't $#a be undef or something? I guess it doesn't matter if someone is
using $a[$#a] without ensuring that @​a > 0.

In any case perl shouldn't segfault on $a[2**31-1].

__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http​://stason.org/ mod_perl Guide ---> http​://perl.apache.org
mailto​:stas@​stason.org http​://use.perl.org http​://apacheweek.com
http​://modperlbook.org http​://apache.org http​://ticketmaster.com

@p5pRT
Copy link
Author

p5pRT commented Nov 5, 2003

From @Abigail

On Wed, Nov 05, 2003 at 02​:18​:11AM -0800, Stas Bekman wrote​:

I wonder why​:

% perl -le '@​a; print $#a'
-1

Shouldn't $#a be undef or something?

No, it shouldn't. 'undef' in numeric context is 0. If $#array would
be undef for empty arrays, the equation​:

  $[ + $#array + 1 == @​array

no longer holds for all arrays, but only for non-empty ones.

You also wouldn't be able to slice as easily anymore. Cases like​:

  my @​slice_to_end = @​array [$from .. $#array];

would need to be special cases.

Abigail

@p5pRT
Copy link
Author

p5pRT commented Nov 5, 2003

From @mjdominus

% perl -le '@​a; print $#a'
-1

Shouldn't $#a be undef or something? I guess it doesn't matter if someone is
using $a[$#a] without ensuring that @​a > 0.

Changing $#a to undef for empty arrays would probaly break more than
90% of all the uses of $#a in the world, including very common code
like this​:

  for my $i (0 .. $#a) {
  ...
  }

and this​:

  for (my $i=0; $i &lt;= $#a; $i++) {
  ...
  }

and this​:

  $n_elements = $#a + 1;

and even this​:

  if ($#ARGV == -1) { ... }

Not all of these are good style, but they are still common.

 

@p5pRT
Copy link
Author

p5pRT commented Nov 5, 2003

From @rgs

Stas Bekman wrote​:

Here is the "fix" that prevent the segfault conditions. Though there is more
problems with Benchmarks.pm which need to be fixed. Next we look at the
segfault itself.

--- Benchmark.pm.orig 2003-11-05 00​:36​:58.000000000 -0800
+++ Benchmark.pm 2003-11-05 00​:38​:26.000000000 -0800

Thanks, applied as #21671.

@p5pRT p5pRT closed this as completed Nov 5, 2003
@p5pRT
Copy link
Author

p5pRT commented Nov 5, 2003

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant