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

[PATCH] Segfault when calling ->next::method on non-existing package #9232

Closed
p5pRT opened this issue Feb 22, 2008 · 9 comments
Closed

[PATCH] Segfault when calling ->next::method on non-existing package #9232

p5pRT opened this issue Feb 22, 2008 · 9 comments

Comments

@p5pRT
Copy link

p5pRT commented Feb 22, 2008

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

Searchable as RT51092$

@p5pRT
Copy link
Author

p5pRT commented Feb 22, 2008

From ilmari@vesla.ilmari.org

This is a bug report for perl from ilmari@​ilmari.org,
generated with the help of perlbug 1.36 running under perl 5.11.0.


When calling ->next​::can on a package name that hasn't been defined at
all, perl segfaults when it tries to do HvNAME_get(NULL).

Here's a patch with a test. I'm not entirely sure whether it should die
or just return undef if !throw_nomethod (like UNIVERSAL->can does).

mro.c | 5 ++++-
t/mro/next_edgecases.t | 14 +++++++++++++-
2 files changed, 17 insertions(+), 2 deletions(-)

Inline Patch
diff --git a/mro.c b/mro.c
index 83872dc..be9a5d4 100644
--- a/mro.c
+++ b/mro.c
@@ -953,8 +953,11 @@ XS(XS_mro_nextcan)
 
     if(sv_isobject(self))
         selfstash = SvSTASH(SvRV(self));
-    else
+    else {
         selfstash = gv_stashsv(self, 0);
+        if(!selfstash)
+            Perl_croak(aTHX_ "Can't call next::method/next::can/maybe::next::method on undefined package \"%s\".", SvPV_nolen_const(self));
+    }
 
     assert(selfstash);
 
diff --git a/t/mro/next_edgecases.t b/t/mro/next_edgecases.t
index 91c2c85..9b872b6 100644
--- a/t/mro/next_edgecases.t
+++ b/t/mro/next_edgecases.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-require q(./test.pl); plan(tests => 11);
+require q(./test.pl); plan(tests => 12);
 
 {
 
@@ -79,4 +79,16 @@ require q(./test.pl); plan(tests => 11);
         eval { $baz->bar() };
         ok($@, '... calling bar() with next::method failed') || diag $@;
     }    
+
+    # Test it failing (instead of segfaulting) with non-existing class
+    {
+        package Qux;
+        use mro;
+        sub foo { No::Such::Class->next::can }
+    }
+
+    eval { Qux->foo() };
+    like($@, qr{Can't call next::method/next::can/maybe::next::method on undefined package},
+         "->next::can on non-existing package name dies correctly")
+
 }
-- 
1.5.3.8

Flags​:
  category=core
  severity=low


Site configuration information for perl 5.11.0​:

Configured by ilmari at Sat Jan 26 04​:38​:10 GMT 2008.

Summary of my perl5 (revision 5 version 11 subversion 0 patch 33054) configuration​:
  Platform​:
  osname=linux, osvers=2.6.24-4-generic, archname=i686-linux
  uname='linux vesla 2.6.24-4-generic #1 smp mon jan 14 17​:30​:39 utc 2008 i686 gnulinux '
  config_args='-Dusedevel -Duserelocatableinc -de -Dprefix=/home/ilmari/perl510'
  hint=recommended, useposix=true, d_sigaction=define
  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='cc', ccflags ='-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
  optimize='-O2',
  cppflags='-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
  ccversion='', gccversion='4.2.3 20080114 (prerelease) (Ubuntu 4.2.2-7ubuntu1)', 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 =' -fstack-protector -L/usr/local/lib'
  libpth=/usr/local/lib /lib /usr/lib /usr/lib64
  libs=-lnsl -ldl -lm -lcrypt -lutil -lc
  perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
  libc=/lib/libc-2.7.so, so=so, useshrplib=false, libperl=libperl.a
  gnulibc_version='2.7'
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
  cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib'

Locally applied patches​:
  DEVEL


@​INC for perl 5.11.0​:
  /home/ilmari/perl510/lib/5.11.0/i686-linux
  /home/ilmari/perl510/lib/5.11.0
  /home/ilmari/perl510/lib/site_perl/5.11.0/i686-linux
  /home/ilmari/perl510/lib/site_perl/5.11.0
  .


Environment for perl 5.11.0​:
  HOME=/home/ilmari
  LANG=en_GB.UTF-8
  LANGUAGE (unset)
  LC_TIME=en_IE.UTF-8
  LD_LIBRARY_PATH=/usr/lib/oracle/xe/app/oracle/product/10.2.0/server/lib
  LOGDIR (unset)
  PATH=/home/ilmari/bin​:/usr/local/sbin​:/usr/local/bin​:/usr/sbin​:/usr/bin​:/sbin​:/bin​:/usr/bin/X11​:/usr/games​:/usr/lib/oracle/xe/app/oracle/product/10.2.0/server/bin
  PERL_BADLANG (unset)
  SHELL=/bin/bash

@p5pRT
Copy link
Author

p5pRT commented Feb 25, 2008

From @rgs

On 22/02/2008, via RT ilmari @​ vesla. ilmari. org
<perlbug-followup@​perl.org> wrote​:

When calling ->next​::can on a package name that hasn't been defined at
all, perl segfaults when it tries to do HvNAME_get(NULL).

Here's a patch with a test. I'm not entirely sure whether it should die
or just return undef if !throw_nomethod (like UNIVERSAL->can does).

Thanks for this patch. Another alternative would be probably to
autovivify the package name, if possible.

Besides this, I don't like the wording of the error message, because
an "undefined package" isn't something that is well-defined in the
perl documentation.

--- a/mro.c
+++ b/mro.c
@​@​ -953,8 +953,11 @​@​ XS(XS_mro_nextcan)

 if\(sv\_isobject\(self\)\)
     selfstash = SvSTASH\(SvRV\(self\)\);

- else
+ else {
selfstash = gv_stashsv(self, 0);
+ if(!selfstash)
+ Perl_croak(aTHX_ "Can't call next​::method/next​::can/maybe​::next​::method on undefined package \"%s\".", SvPV_nolen_const(self));
+ }

 assert\(selfstash\);

diff --git a/t/mro/next_edgecases.t b/t/mro/next_edgecases.t
index 91c2c85..9b872b6 100644
--- a/t/mro/next_edgecases.t
+++ b/t/mro/next_edgecases.t
@​@​ -3,7 +3,7 @​@​
use strict;
use warnings;

-require q(./test.pl); plan(tests => 11);
+require q(./test.pl); plan(tests => 12);

{

@​@​ -79,4 +79,16 @​@​ require q(./test.pl); plan(tests => 11);
eval { $baz->bar() };
ok($@​, '... calling bar() with next​::method failed') || diag $@​;
}
+
+ # Test it failing (instead of segfaulting) with non-existing class
+ {
+ package Qux;
+ use mro;
+ sub foo { No​::Such​::Class->next​::can }
+ }
+
+ eval { Qux->foo() };
+ like($@​, qr{Can't call next​::method/next​::can/maybe​::next​::method on undefined package},
+ "->next​::can on non-existing package name dies correctly")
+
}

@p5pRT
Copy link
Author

p5pRT commented Feb 25, 2008

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

@p5pRT
Copy link
Author

p5pRT commented Feb 25, 2008

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

@p5pRT p5pRT closed this as completed Feb 25, 2008
@p5pRT
Copy link
Author

p5pRT commented Feb 25, 2008

From @rgs

On 25/02/2008, Rafael Garcia-Suarez <rgarciasuarez@​gmail.com> wrote​:

Thanks for this patch. Another alternative would be probably to
autovivify the package name, if possible.

That's what I applied :

Change 33367 by rgs@​stcosmo on 2008/02/25 10​:54​:47

  Avoid a segfault case in MRO code, based on :
 
  Subject​: [perl #51092] [PATCH] Segfault when calling ->next​::method
on non-existing package
  From​: ilmari@​vesla.ilmari.org (via RT) <perlbug-followup@​perl.org>
  Date​: Thu, 21 Feb 2008 20​:29​:42 -0800
  Message-ID​: <rt-3.6.HEAD-15287-1203654581-377.51092-75-0@​perl.org>

Affected files ...

... //depot/perl/mro.c#46 edit
... //depot/perl/t/mro/next_edgecases.t#2 edit

Differences ...

==== //depot/perl/mro.c#46 (text) ====

@​@​ -954,7 +954,7 @​@​
  if(sv_isobject(self))
  selfstash = SvSTASH(SvRV(self));
  else
- selfstash = gv_stashsv(self, 0);
+ selfstash = gv_stashsv(self, GV_ADD);

  assert(selfstash);

==== //depot/perl/t/mro/next_edgecases.t#2 (text) ====

@​@​ -3,7 +3,7 @​@​
use strict;
use warnings;

-require q(./test.pl); plan(tests => 11);
+require q(./test.pl); plan(tests => 12);

{

@​@​ -78,5 +78,16 @​@​

  eval { $baz->bar() };
  ok($@​, '... calling bar() with next​::method failed') || diag $@​;
- }
+ }
+
+ # Test with non-existing class (used to segfault)
+ {
+ package Qux;
+ use mro;
+ sub foo { No​::Such​::Class->next​::can }
+ }
+
+ eval { Qux->foo() };
+ is($@​, '', "->next​::can on non-existing package name");
+
}

@p5pRT
Copy link
Author

p5pRT commented Feb 27, 2008

From david@landgren.net

Rafael Garcia-Suarez wrote​:

On 25/02/2008, Rafael Garcia-Suarez <rgarciasuarez@​gmail.com> wrote​:

Thanks for this patch. Another alternative would be probably to
autovivify the package name, if possible.

That's what I applied :

Minor quibble (I'm way behind on sumamrising)

+ # Test with non-existing class (used to segfault)

I thought the general movement these days was to embed the bug number in
the test

+ eval { Qux->foo() };
+ is($@​, '', "->next​::can on non-existing package name");

so

is($@​, '', "->next​::can on non-existing package name (RT bug #51092)");

David

@p5pRT
Copy link
Author

p5pRT commented Feb 28, 2008

From @nwc10

On Wed, Feb 27, 2008 at 02​:49​:22PM +0100, David Landgren wrote​:

Minor quibble (I'm way behind on sumamrising)

Is there anything we can do to help this?
(Apart from writing fewer e-mails, of course.)

Nicholas Clark

@p5pRT
Copy link
Author

p5pRT commented Feb 28, 2008

From david@landgren.net

Nicholas Clark wrote​:

On Wed, Feb 27, 2008 at 02​:49​:22PM +0100, David Landgren wrote​:

Minor quibble (I'm way behind on sumamrising)

Is there anything we can do to help this?

I wasn't complaining, and in fact managed to finish the summary tonight.
Which is just as well, because I'll be offline until Monday night.

(Apart from writing fewer e-mails, of course.)

Yes, that would be a good idea. Starting from now, you all have an
allowance of two messages per week. Use them wisely.

David

@p5pRT
Copy link
Author

p5pRT commented Feb 29, 2008

From @nwc10

On Fri, Feb 29, 2008 at 12​:41​:24AM +0100, David Landgren wrote​:

Nicholas Clark wrote​:

On Wed, Feb 27, 2008 at 02​:49​:22PM +0100, David Landgren wrote​:

Minor quibble (I'm way behind on sumamrising)

Is there anything we can do to help this?

I wasn't complaining, and in fact managed to finish the summary tonight.
Which is just as well, because I'll be offline until Monday night.

(Apart from writing fewer e-mails, of course.)

Yes, that would be a good idea. Starting from now, you all have an
allowance of two messages per week. Use them wisely.

I asked Robert, and he said

  # ezmlm-list /home/perlmail/perl5-porters{,/digest} | wc -l
  485

  Current stats seem to show about 38 messages per day.

Sooooo

If we all send two messages a week, that's 970 in total :-)
Which is only 5 times as much as the current rate.

Nicholas Clark

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

No branches or pull requests

1 participant