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

Fix potential segfault from pp_sort.c #16129

Closed
p5pRT opened this issue Aug 28, 2017 · 22 comments
Closed

Fix potential segfault from pp_sort.c #16129

p5pRT opened this issue Aug 28, 2017 · 22 comments

Comments

@p5pRT
Copy link

p5pRT commented Aug 28, 2017

Migrated from rt.perl.org#131984 (status was 'open')

Searchable as RT131984$

@p5pRT
Copy link
Author

p5pRT commented Aug 28, 2017

From @jplinderman

Attached is what perlbug left in my mail spool. Mail cannot be sent from my
PC.

@p5pRT
Copy link
Author

p5pRT commented Aug 28, 2017

From @jplinderman

Created by @jplinderman

S_mergesortsv was saving the current comparison routine only when the
SORTf_DESC flag was set, but "restoring" it when ANY flag was set.
When some flag other than SORTf_DESC was set, this could lead to
the pointer to the comparison routine being set to NULL,
triggering a segfault when the routine was subsequently invoked.

The attached patch restores the pointer to the comparison routine
only when the saved pointer is not NULL. It also adds code to lib/sort.t
to verify that the segfault is no longer happening.

For what it's worth, this bug has gone undetected because embedding a sort
in a comparison routine is uncommon (and usually ill-advised).
Even then, the problem only arises when some sort flag is set,
so a simple sort won't trigger the segfault.

Perl Info

Flags:
    category=core
    severity=high

Site configuration information for perl 5.27.4:

Configured by jpl at Fri Aug 25 13:56:24 EDT 2017.

Summary of my perl5 (revision 5 version 27 subversion 4) configuration:
  Derived from: 43272d222fe12f33c708d42b2a71af36cc92e4bd
  Platform:
    osname=linux
    osvers=4.4.0-83-generic
    archname=x86_64-linux
    uname='linux jpl 4.4.0-83-generic #106-ubuntu smp mon jun 26 17:54:43 utc 2017 x86_64 x86_64 x86_64 gnulinux '
    config_args=''
    hint=recommended
    useposix=true
    d_sigaction=define
    useithreads=undef
    usemultiplicity=undef
    use64bitint=define
    use64bitall=define
    uselongdouble=undef
    usemymalloc=n
    default_inc_excludes_dot=define
    bincompat5005=undef
  Compiler:
    cc='cc'
    ccflags ='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
    optimize='-O2'
    cppflags='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include'
    ccversion=''
    gccversion='5.4.0 20160609'
    gccosandvers=''
    intsize=4
    longsize=8
    ptrsize=8
    doublesize=8
    byteorder=12345678
    doublekind=3
    d_longlong=define
    longlongsize=8
    d_longdbl=define
    longdblsize=16
    longdblkind=3
    ivtype='long'
    ivsize=8
    nvtype='double'
    nvsize=8
    Off_t='off_t'
    lseeksize=8
    alignbytes=8
    prototype=define
  Linker and Libraries:
    ld='cc'
    ldflags =' -fstack-protector-strong -L/usr/local/lib'
    libpth=/usr/local/lib /usr/lib/gcc/x86_64-linux-gnu/5/include-fixed /usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib
    libs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    libc=libc-2.23.so
    so=so
    useshrplib=false
    libperl=libperl.a
    gnulibc_version='2.23'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs
    dlext=so
    d_dlsymun=undef
    ccdlflags='-Wl,-E'
    cccdlflags='-fPIC'
    lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector-strong'

Locally applied patches:
    uncommitted-changes


@INC for perl 5.27.4:
    /home/jpl/perl5.27.4/lib/site_perl/5.27.4/x86_64-linux
    /home/jpl/perl5.27.4/lib/site_perl/5.27.4
    /home/jpl/perl5.27.4/lib/5.27.4/x86_64-linux
    /home/jpl/perl5.27.4/lib/5.27.4


Environment for perl 5.27.4:
    HOME=/home/jpl
    LANG=C.UTF-8
    LANGUAGE=en_US
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/jpl/x86_64bin:/home/jpl/bin:/home/jpl/go/bin:/bin:/usr/bin:/usr/sbin:/sbin:/usr/local/bin:/usr/games:.:/home/jpl/wordnet/bin:/home/jpl/U/Production/bin
    PERL_BADLANG (unset)
    SHELL=/bin/ksh

--------------1.40.perlbug
Content-Type: text/x-patch; name="patches.txt"
Content-Transfer-Encoding: 8bit
Content-Disposition: attachment; filename="patches.txt"

From ce1bba6544d0e22926f4f1af432705f73d072eb2 Mon Sep 17 00:00:00 2001
From: jpl <jpl.jpl@gmail.com>
Date: Mon, 28 Aug 2017 09:54:15 -0400
Subject: [PATCH] Change save/restore behavior for comparisons

S_mergesortsv was saving the current comparison routine only when the
SORTf_DESC flag was set, but "restoring" it when ANY flag was set.
When some flag other than SORTf_DESC was set, this could lead to
the pointer to the comparison routine being set to NULL,
triggering a segfault when the routine was subsequently invoked.

 lib/sort.t | 17 ++++++++++++++++-
 pp_sort.c  |  2 +-
 2 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/lib/sort.t b/lib/sort.t
index b44269a..1ff3832 100644
--- a/lib/sort.t
+++ b/lib/sort.t
@@ -130,9 +130,24 @@ sub main {
     }
 }
 
-# Test with no pragma still loaded -- stability expected (this is a mergesort)
+# Test with no pragma yet loaded. Stability is expected from default sort.
 main(sub { sort {&{$_[0]}} @{$_[1]} }, 0);
 
+# Verify that we have eliminated the segfault that could be triggered
+# by invoking a sort as part of a comparison routine.
+# No need for an explicit test. If we don't segfault, we're good.
+
+{
+    sub dumbsort {
+	my ($a, $b) = @_;
+	use sort qw( defaults stable );
+	my @ignore = sort (5,4,3,2,1);
+	return $a <=> $b;
+    }
+    use sort qw( defaults _qsort stable );
+    my @nested = sort { dumbsort($a,$b) } (3,2,2,1);
+}
+
 {
     use sort qw(_qsort);
     my $sort_current; BEGIN { $sort_current = sort::current(); }
diff --git a/pp_sort.c b/pp_sort.c
index ee1dc5d..e0f4182 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -558,7 +558,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
     }
   done:
     if (aux != small) Safefree(aux);	/* free iff allocated */
-    if (flags) {
+    if (savecmp != NULL) {
 	 PL_sort_RealCmp = savecmp;	/* Restore current comparison routine, if any */
     }
     return;
-- 
2.7.4


--------------1.40.perlbug--

@p5pRT
Copy link
Author

p5pRT commented Aug 29, 2017

From @jkeenan

On Mon, 28 Aug 2017 22​:41​:29 GMT, jpl.jpl@​gmail.com wrote​:

Attached is what perlbug left in my mail spool. Mail cannot be sent from my
PC.

In the years since the individual tests in lib/sort.t were created, it's become customary to produce test output that explicitly states that we did not have a crash or segfault where previously we would have had one.

Hence, for the modifications for lib/sort.t I would prefer the '0002' patch I'm attaching to this RT.

Since we prefer spaces to hard tabs in newly added code, I have also reformatted one test block.

Please review. Thank you very much.
--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Aug 29, 2017

From @jkeenan

0001-Change-save-restore-behavior-for-comparisons.patch
From 5fff7c19cd13984f53bc77b360fcdf90cd375551 Mon Sep 17 00:00:00 2001
From: jpl <jpl.jpl@gmail.com>
Date: Mon, 28 Aug 2017 09:54:15 -0400
Subject: [PATCH 1/2] Change save/restore behavior for comparisons

S_mergesortsv was saving the current comparison routine only when the
SORTf_DESC flag was set, but "restoring" it when ANY flag was set.
When some flag other than SORTf_DESC was set, this could lead to
the pointer to the comparison routine being set to NULL,
triggering a segfault when the routine was subsequently invoked.
---
 lib/sort.t | 17 ++++++++++++++++-
 pp_sort.c  |  2 +-
 2 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/lib/sort.t b/lib/sort.t
index b44269a..1ff3832 100644
--- a/lib/sort.t
+++ b/lib/sort.t
@@ -130,9 +130,24 @@ sub main {
     }
 }
 
-# Test with no pragma still loaded -- stability expected (this is a mergesort)
+# Test with no pragma yet loaded. Stability is expected from default sort.
 main(sub { sort {&{$_[0]}} @{$_[1]} }, 0);
 
+# Verify that we have eliminated the segfault that could be triggered
+# by invoking a sort as part of a comparison routine.
+# No need for an explicit test. If we don't segfault, we're good.
+
+{
+    sub dumbsort {
+	my ($a, $b) = @_;
+	use sort qw( defaults stable );
+	my @ignore = sort (5,4,3,2,1);
+	return $a <=> $b;
+    }
+    use sort qw( defaults _qsort stable );
+    my @nested = sort { dumbsort($a,$b) } (3,2,2,1);
+}
+
 {
     use sort qw(_qsort);
     my $sort_current; BEGIN { $sort_current = sort::current(); }
diff --git a/pp_sort.c b/pp_sort.c
index ee1dc5d..e0f4182 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -558,7 +558,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
     }
   done:
     if (aux != small) Safefree(aux);	/* free iff allocated */
-    if (flags) {
+    if (savecmp != NULL) {
 	 PL_sort_RealCmp = savecmp;	/* Restore current comparison routine, if any */
     }
     return;
-- 
2.7.4

@p5pRT
Copy link
Author

p5pRT commented Aug 29, 2017

From @jkeenan

0002-Make-explicit-that-we-did-not-segfault.patch
From a97b249566872bfc9f297c723d08f847e696eabf Mon Sep 17 00:00:00 2001
From: James E Keenan <jkeenan@cpan.org>
Date: Mon, 28 Aug 2017 21:57:28 -0400
Subject: [PATCH 2/2] Make explicit that we did not segfault.

Do not use hard tabs in newly added test blocks.
---
 lib/sort.t | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/lib/sort.t b/lib/sort.t
index 1ff3832..8688bb2 100644
--- a/lib/sort.t
+++ b/lib/sort.t
@@ -28,6 +28,7 @@ use warnings;
 use Test::More tests => @TestSizes * 2	# sort() tests
 			* 6		# number of pragmas to test
 			+ 1 		# extra test for qsort instability
+			+ 1 		# extra test to demonstrate no segfault
 			+ 3		# tests for sort::current
 			+ 3;		# tests for "defaults" and "no sort"
 
@@ -135,17 +136,17 @@ main(sub { sort {&{$_[0]}} @{$_[1]} }, 0);
 
 # Verify that we have eliminated the segfault that could be triggered
 # by invoking a sort as part of a comparison routine.
-# No need for an explicit test. If we don't segfault, we're good.
 
 {
     sub dumbsort {
-	my ($a, $b) = @_;
-	use sort qw( defaults stable );
-	my @ignore = sort (5,4,3,2,1);
-	return $a <=> $b;
+        my ($a, $b) = @_;
+        use sort qw( defaults stable );
+        my @ignore = sort (5,4,3,2,1);
+        return $a <=> $b;
     }
     use sort qw( defaults _qsort stable );
     my @nested = sort { dumbsort($a,$b) } (3,2,2,1);
+    pass("No segfault when sort invoked as part of comparison routine: RT #131984");
 }
 
 {
-- 
2.7.4

@p5pRT
Copy link
Author

p5pRT commented Aug 29, 2017

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

@p5pRT
Copy link
Author

p5pRT commented Aug 29, 2017

From @jkeenan

On Tue, 29 Aug 2017 02​:06​:28 GMT, jkeenan wrote​:

On Mon, 28 Aug 2017 22​:41​:29 GMT, jpl.jpl@​gmail.com wrote​:

Attached is what perlbug left in my mail spool. Mail cannot be sent
from my
PC.

In the years since the individual tests in lib/sort.t were created,
it's become customary to produce test output that explicitly states
that we did not have a crash or segfault where previously we would
have had one.

Hence, for the modifications for lib/sort.t I would prefer the '0002'
patch I'm attaching to this RT.

Since we prefer spaces to hard tabs in newly added code, I have also
reformatted one test block.

Please review. Thank you very much.

Available for smoking in branch​:
smoke-me/jkeenan/jpl/131984-sort

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Aug 29, 2017

From @tonycoz

On Mon, 28 Aug 2017 15​:41​:29 -0700, jpl.jpl@​gmail.com wrote​:

Attached is what perlbug left in my mail spool. Mail cannot be sent from my
PC.

The patch makes sense to me.

I do suspect both before and after your change there's an issue if an inner sort dies and is caught within the outer sort.

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 29, 2017

From @jplinderman

The changes look good. I'll try to remember to use blanks instead of tabs
in future changes to test code. Now that I (think I) know why perlbug
failed, I'll generate the changes and send them from google mail in the
future.

On Mon, Aug 28, 2017 at 10​:06 PM, James E Keenan via RT <
perlbug-followup@​perl.org> wrote​:

On Mon, 28 Aug 2017 22​:41​:29 GMT, jpl.jpl@​gmail.com wrote​:

Attached is what perlbug left in my mail spool. Mail cannot be sent from
my
PC.

In the years since the individual tests in lib/sort.t were created, it's
become customary to produce test output that explicitly states that we did
not have a crash or segfault where previously we would have had one.

Hence, for the modifications for lib/sort.t I would prefer the '0002'
patch I'm attaching to this RT.

Since we prefer spaces to hard tabs in newly added code, I have also
reformatted one test block.

Please review. Thank you very much.
--
James E Keenan (jkeenan@​cpan.org)

From 5fff7c1 Mon Sep 17 00​:00​:00 2001
From​: jpl <jpl.jpl@​gmail.com>
Date​: Mon, 28 Aug 2017 09​:54​:15 -0400
Subject​: [PATCH 1/2] Change save/restore behavior for comparisons

S_mergesortsv was saving the current comparison routine only when the
SORTf_DESC flag was set, but "restoring" it when ANY flag was set.
When some flag other than SORTf_DESC was set, this could lead to
the pointer to the comparison routine being set to NULL,
triggering a segfault when the routine was subsequently invoked.
---
lib/sort.t | 17 ++++++++++++++++-
pp_sort.c | 2 +-
2 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/lib/sort.t b/lib/sort.t
index b44269a..1ff3832 100644
--- a/lib/sort.t
+++ b/lib/sort.t
@​@​ -130,9 +130,24 @​@​ sub main {
}
}

-# Test with no pragma still loaded -- stability expected (this is a
mergesort)
+# Test with no pragma yet loaded. Stability is expected from default sort.
main(sub { sort {&{$_[0]}} @​{$_[1]} }, 0);

+# Verify that we have eliminated the segfault that could be triggered
+# by invoking a sort as part of a comparison routine.
+# No need for an explicit test. If we don't segfault, we're good.
+
+{
+ sub dumbsort {
+ my ($a, $b) = @​_;
+ use sort qw( defaults stable );
+ my @​ignore = sort (5,4,3,2,1);
+ return $a <=> $b;
+ }
+ use sort qw( defaults _qsort stable );
+ my @​nested = sort { dumbsort($a,$b) } (3,2,2,1);
+}
+
{
use sort qw(_qsort);
my $sort_current; BEGIN { $sort_current = sort​::current(); }
diff --git a/pp_sort.c b/pp_sort.c
index ee1dc5d..e0f4182 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@​@​ -558,7 +558,7 @​@​ S_mergesortsv(pTHX_ gptr *base, size_t nmemb,
SVCOMPARE_t cmp, U32 flags)
}
done​:
if (aux != small) Safefree(aux); /* free iff allocated */
- if (flags) {
+ if (savecmp != NULL) {
PL_sort_RealCmp = savecmp; /* Restore current comparison
routine, if any */
}
return;
--
2.7.4

From a97b249 Mon Sep 17 00​:00​:00 2001
From​: James E Keenan <jkeenan@​cpan.org>
Date​: Mon, 28 Aug 2017 21​:57​:28 -0400
Subject​: [PATCH 2/2] Make explicit that we did not segfault.

Do not use hard tabs in newly added test blocks.
---
lib/sort.t | 11 ++++++-----
1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/lib/sort.t b/lib/sort.t
index 1ff3832..8688bb2 100644
--- a/lib/sort.t
+++ b/lib/sort.t
@​@​ -28,6 +28,7 @​@​ use warnings;
use Test​::More tests => @​TestSizes * 2 # sort() tests
* 6 # number of pragmas to test
+ 1 # extra test for qsort instability
+ + 1 # extra test to demonstrate no
segfault
+ 3 # tests for sort​::current
+ 3; # tests for "defaults" and "no
sort"

@​@​ -135,17 +136,17 @​@​ main(sub { sort {&{$_[0]}} @​{$_[1]} }, 0);

# Verify that we have eliminated the segfault that could be triggered
# by invoking a sort as part of a comparison routine.
-# No need for an explicit test. If we don't segfault, we're good.

{
sub dumbsort {
- my ($a, $b) = @​_;
- use sort qw( defaults stable );
- my @​ignore = sort (5,4,3,2,1);
- return $a <=> $b;
+ my ($a, $b) = @​_;
+ use sort qw( defaults stable );
+ my @​ignore = sort (5,4,3,2,1);
+ return $a <=> $b;
}
use sort qw( defaults _qsort stable );
my @​nested = sort { dumbsort($a,$b) } (3,2,2,1);
+ pass("No segfault when sort invoked as part of comparison routine​: RT
#131984");
}

{
--
2.7.4

@p5pRT
Copy link
Author

p5pRT commented Aug 29, 2017

From @jplinderman

I agree, Tony, but I don't know what to do about it. The saving grace, I
guess, is that invoking a sort as part of a comparison routine is bizarre.
It would have to be invoked for side effects only, because the result of
comparing two elements *should* depend only on the values of those
elements. And it's a stretch for me to figure out why that might be useful.
Which is why my test case does nothing with the results of the nested sort.
If we could disallow nested sorts, I doubt that it would break any code,
and might expose some logic errors... "I thought I could take a look at the
array as it was being sorted".

On Tue, Aug 29, 2017 at 12​:52 AM, Tony Cook via RT <
perlbug-followup@​perl.org> wrote​:

On Mon, 28 Aug 2017 15​:41​:29 -0700, jpl.jpl@​gmail.com wrote​:

Attached is what perlbug left in my mail spool. Mail cannot be sent from
my
PC.

The patch makes sense to me.

I do suspect both before and after your change there's an issue if an
inner sort dies and is caught within the outer sort.

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 29, 2017

From @hvds

On Tue, 29 Aug 2017 04​:16​:28 -0700, jpl.jpl@​gmail.com wrote​:

The saving grace, I
guess, is that invoking a sort as part of a comparison routine is bizarre.

Done indirectly, it's not so surprising - { $a->method <=> $b->method } is a perfectly reasonable comparator, and the method may do all sorts of things.

Hugo

@p5pRT
Copy link
Author

p5pRT commented Aug 29, 2017

From @jplinderman

The method can do all sorts😀 of things, but it must always return
consistent results for the same $a and $b. That's the "contract" between
sort and the user. So the outcome of anything done by the method must not
influence what is returned. One might produce a report of how the top 10
stocks change from comparison to comparison, but that's a stretch, and
prohibiting it has beneficial effects, as Tony observed. If I could see a
reasonable comparator that involved a sort, I'd soften my position, but I
have no intention (nor ability) to prohibit nested sorts, so my position
isn't particularly important.

On Tue, Aug 29, 2017 at 3​:05 PM, Hugo van der Sanden via RT <
perlbug-followup@​perl.org> wrote​:

On Tue, 29 Aug 2017 04​:16​:28 -0700, jpl.jpl@​gmail.com wrote​:

The saving grace, I
guess, is that invoking a sort as part of a comparison routine is
bizarre.

Done indirectly, it's not so surprising - { $a->method <=> $b->method } is
a perfectly reasonable comparator, and the method may do all sorts of
things.

Hugo

@p5pRT
Copy link
Author

p5pRT commented Aug 30, 2017

From @jplinderman

Here's a case that I find plausible. You have an array of hashrefs, each
describing statistics about a sample dataset (that is part of each hash).
You want to sort the hashrefs on the median of their datasets. So the
comparison function sorts the dataset (unless it has already been sorted,
so it's only done once), and uses the sorted dataset to determine the
median.

On Tue, Aug 29, 2017 at 3​:05 PM, Hugo van der Sanden via RT <
perlbug-followup@​perl.org> wrote​:

On Tue, 29 Aug 2017 04​:16​:28 -0700, jpl.jpl@​gmail.com wrote​:

The saving grace, I
guess, is that invoking a sort as part of a comparison routine is
bizarre.

Done indirectly, it's not so surprising - { $a->method <=> $b->method } is
a perfectly reasonable comparator, and the method may do all sorts of
things.

Hugo

@p5pRT
Copy link
Author

p5pRT commented Aug 30, 2017

From zefram@fysh.org

John P. Linderman wrote​:

                                                    If I could see a

reasonable comparator that involved a sort,

{ join("\0", sort $a->flanges) cmp join("\0", sort $b->flanges) }

-zefram

@p5pRT
Copy link
Author

p5pRT commented Sep 4, 2017

From @jplinderman

Is this commit waiting for something from me? I see that other commits to
pp_sort.c have been made​:

commit f6107ca

I'd like to continue work on destabilization, but I'd like to start from a
point where the segfault problem has been addressed.

On Mon, Aug 28, 2017 at 10​:06 PM, James E Keenan via RT <
perlbug-followup@​perl.org> wrote​:

On Mon, 28 Aug 2017 22​:41​:29 GMT, jpl.jpl@​gmail.com wrote​:

Attached is what perlbug left in my mail spool. Mail cannot be sent from
my
PC.

In the years since the individual tests in lib/sort.t were created, it's
become customary to produce test output that explicitly states that we did
not have a crash or segfault where previously we would have had one.

Hence, for the modifications for lib/sort.t I would prefer the '0002'
patch I'm attaching to this RT.

Since we prefer spaces to hard tabs in newly added code, I have also
reformatted one test block.

Please review. Thank you very much.
--
James E Keenan (jkeenan@​cpan.org)

From 5fff7c1 Mon Sep 17 00​:00​:00 2001
From​: jpl <jpl.jpl@​gmail.com>
Date​: Mon, 28 Aug 2017 09​:54​:15 -0400
Subject​: [PATCH 1/2] Change save/restore behavior for comparisons

S_mergesortsv was saving the current comparison routine only when the
SORTf_DESC flag was set, but "restoring" it when ANY flag was set.
When some flag other than SORTf_DESC was set, this could lead to
the pointer to the comparison routine being set to NULL,
triggering a segfault when the routine was subsequently invoked.
---
lib/sort.t | 17 ++++++++++++++++-
pp_sort.c | 2 +-
2 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/lib/sort.t b/lib/sort.t
index b44269a..1ff3832 100644
--- a/lib/sort.t
+++ b/lib/sort.t
@​@​ -130,9 +130,24 @​@​ sub main {
}
}

-# Test with no pragma still loaded -- stability expected (this is a
mergesort)
+# Test with no pragma yet loaded. Stability is expected from default sort.
main(sub { sort {&{$_[0]}} @​{$_[1]} }, 0);

+# Verify that we have eliminated the segfault that could be triggered
+# by invoking a sort as part of a comparison routine.
+# No need for an explicit test. If we don't segfault, we're good.
+
+{
+ sub dumbsort {
+ my ($a, $b) = @​_;
+ use sort qw( defaults stable );
+ my @​ignore = sort (5,4,3,2,1);
+ return $a <=> $b;
+ }
+ use sort qw( defaults _qsort stable );
+ my @​nested = sort { dumbsort($a,$b) } (3,2,2,1);
+}
+
{
use sort qw(_qsort);
my $sort_current; BEGIN { $sort_current = sort​::current(); }
diff --git a/pp_sort.c b/pp_sort.c
index ee1dc5d..e0f4182 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@​@​ -558,7 +558,7 @​@​ S_mergesortsv(pTHX_ gptr *base, size_t nmemb,
SVCOMPARE_t cmp, U32 flags)
}
done​:
if (aux != small) Safefree(aux); /* free iff allocated */
- if (flags) {
+ if (savecmp != NULL) {
PL_sort_RealCmp = savecmp; /* Restore current comparison
routine, if any */
}
return;
--
2.7.4

From a97b249 Mon Sep 17 00​:00​:00 2001
From​: James E Keenan <jkeenan@​cpan.org>
Date​: Mon, 28 Aug 2017 21​:57​:28 -0400
Subject​: [PATCH 2/2] Make explicit that we did not segfault.

Do not use hard tabs in newly added test blocks.
---
lib/sort.t | 11 ++++++-----
1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/lib/sort.t b/lib/sort.t
index 1ff3832..8688bb2 100644
--- a/lib/sort.t
+++ b/lib/sort.t
@​@​ -28,6 +28,7 @​@​ use warnings;
use Test​::More tests => @​TestSizes * 2 # sort() tests
* 6 # number of pragmas to test
+ 1 # extra test for qsort instability
+ + 1 # extra test to demonstrate no
segfault
+ 3 # tests for sort​::current
+ 3; # tests for "defaults" and "no
sort"

@​@​ -135,17 +136,17 @​@​ main(sub { sort {&{$_[0]}} @​{$_[1]} }, 0);

# Verify that we have eliminated the segfault that could be triggered
# by invoking a sort as part of a comparison routine.
-# No need for an explicit test. If we don't segfault, we're good.

{
sub dumbsort {
- my ($a, $b) = @​_;
- use sort qw( defaults stable );
- my @​ignore = sort (5,4,3,2,1);
- return $a <=> $b;
+ my ($a, $b) = @​_;
+ use sort qw( defaults stable );
+ my @​ignore = sort (5,4,3,2,1);
+ return $a <=> $b;
}
use sort qw( defaults _qsort stable );
my @​nested = sort { dumbsort($a,$b) } (3,2,2,1);
+ pass("No segfault when sort invoked as part of comparison routine​: RT
#131984");
}

{
--
2.7.4

@p5pRT
Copy link
Author

p5pRT commented Sep 10, 2017

From @jplinderman

There's a Draconian, but I think effective, workaround. Assign the original
comparison routine to PL_sort_RealCmp before *every* comparison. That's
NlogN assignments rather than 1, but it's probably insignificant relative
to all the other stuff that happens around comparisons. This makes one
appreciate how painful it is that C does not support closures. The authors
of *go* didn't repeat that oversight.

On Tue, Aug 29, 2017 at 12​:52 AM, Tony Cook via RT <
perlbug-followup@​perl.org> wrote​:

On Mon, 28 Aug 2017 15​:41​:29 -0700, jpl.jpl@​gmail.com wrote​:

Attached is what perlbug left in my mail spool. Mail cannot be sent from
my
PC.

The patch makes sense to me.

I do suspect both before and after your change there's an issue if an
inner sort dies and is caught within the outer sort.

Tony

@p5pRT
Copy link
Author

p5pRT commented Sep 10, 2017

From @tonycoz

On Sun, Sep 10, 2017 at 09​:53​:58AM -0400, John P. Linderman wrote​:

On Tue, Aug 29, 2017 at 12​:52 AM, Tony Cook via RT <
perlbug-followup@​perl.org> wrote​:

On Mon, 28 Aug 2017 15​:41​:29 -0700, jpl.jpl@​gmail.com wrote​:

Attached is what perlbug left in my mail spool. Mail cannot be sent from
my
PC.

The patch makes sense to me.

I do suspect both before and after your change there's an issue if an
inner sort dies and is caught within the outer sort.

Tony

There's a Draconian, but I think effective, workaround. Assign the original
comparison routine to PL_sort_RealCmp before *every* comparison. That's
NlogN assignments rather than 1, but it's probably insignificant relative
to all the other stuff that happens around comparisons. This makes one
appreciate how painful it is that C does not support closures. The authors
of *go* didn't repeat that oversight.

The general solution for this type of thing in core is usually a
SAVE*() macro such as SAVEPPTR() (see scope.h, scope.c), but function
pointers are generally not compatible with data pointers.

So we'd need a new macro, code in scope.c to handle it, and a call to it
in pp_sort.c

Tony

@p5pRT
Copy link
Author

p5pRT commented Sep 21, 2017

From @tonycoz

On Mon, 04 Sep 2017 08​:03​:29 -0700, jpl.jpl@​gmail.com wrote​:

Is this commit waiting for something from me? I see that other commits
to
pp_sort.c have been made​:

commit f6107ca

I'd like to continue work on destabilization, but I'd like to start
from a
point where the segfault problem has been addressed.

Thanks, applied as 0e1d050.

Leaving open for now, since we still have a known issue.

Tony

@jkeenan
Copy link
Contributor

jkeenan commented Mar 2, 2020

From @tonycoz

On Mon, 04 Sep 2017 08​:03​:29 -0700, jpl.jpl@​gmail.com wrote​:

Is this commit waiting for something from me? I see that other commits
to
pp_sort.c have been made​:
commit f6107ca
I'd like to continue work on destabilization, but I'd like to start
from a
point where the segfault problem has been addressed.

Thanks, applied as 0e1d050.

Leaving open for now, since we still have a known issue.

Tony

@tonycoz, could you review this ticket and clarify the "known issue"?

It might make sense to open a new GH issue for that.

@jplinderman

Thank you very much.
Jim Keenan

xenu added a commit to xenu/perl5 that referenced this issue Mar 2, 2020
This makes special-cased forms such as sort { $a <=> $b }
even faster.

Also, since this commit removes PL_sort_RealCmp, it fixes the
issue with nested sort calls mentioned in gh Perl#16129
xenu added a commit to xenu/perl5 that referenced this issue Mar 2, 2020
This makes special-cased forms such as sort { $b <=> $a }
even faster.

Also, since this commit removes PL_sort_RealCmp, it fixes the
issue with nested sort calls mentioned in gh Perl#16129
xenu added a commit to xenu/perl5 that referenced this issue Mar 2, 2020
This makes special-cased forms such as sort { $b <=> $a }
even faster.

Also, since this commit removes PL_sort_RealCmp, it fixes the
issue with nested sort calls mentioned in gh Perl#16129
@jplinderman
Copy link
Contributor

jplinderman commented Mar 3, 2020 via email

@Grinnz
Copy link
Contributor

Grinnz commented Mar 3, 2020

I'll copy/paste a related snippet, although you probably already know about it. It went to perlbug-followup. -- jpl

perlbug-followup no longer works, unfortunately (though it possibly did on that date).

xenu added a commit to xenu/perl5 that referenced this issue Mar 3, 2020
This makes special-cased forms such as sort { $b <=> $a }
even faster.

Also, since this commit removes PL_sort_RealCmp, it fixes the
issue with nested sort calls mentioned in gh Perl#16129
xenu added a commit to xenu/perl5 that referenced this issue Mar 4, 2020
This makes special-cased forms such as sort { $b <=> $a }
even faster.

Also, since this commit removes PL_sort_RealCmp, it fixes the
issue with nested sort calls mentioned in gh Perl#16129
xenu added a commit to xenu/perl5 that referenced this issue Mar 4, 2020
This makes special-cased forms such as sort { $b <=> $a }
even faster.

Also, since this commit removes PL_sort_RealCmp, it fixes the
issue with nested sort calls mentioned in gh Perl#16129
xenu added a commit to xenu/perl5 that referenced this issue Mar 8, 2020
This makes special-cased forms such as sort { $b <=> $a }
even faster.

Also, since this commit removes PL_sort_RealCmp, it fixes the
issue with nested sort calls mentioned in gh Perl#16129
xenu added a commit to xenu/perl5 that referenced this issue Mar 9, 2020
This makes special-cased forms such as sort { $b <=> $a }
even faster.

Also, since this commit removes PL_sort_RealCmp, it fixes the
issue with nested sort calls mentioned in gh Perl#16129
xenu added a commit to xenu/perl5 that referenced this issue Mar 9, 2020
This makes special-cased forms such as sort { $b <=> $a }
even faster.

Also, since this commit removes PL_sort_RealCmp, it fixes the
issue with nested sort calls mentioned in gh Perl#16129
xenu added a commit to xenu/perl5 that referenced this issue Mar 9, 2020
This makes special-cased forms such as sort { $b <=> $a }
even faster.

Also, since this commit removes PL_sort_RealCmp, it fixes the
issue with nested sort calls mentioned in gh Perl#16129
khwilliamson pushed a commit that referenced this issue Mar 9, 2020
This makes special-cased forms such as sort { $b <=> $a }
even faster.

Also, since this commit removes PL_sort_RealCmp, it fixes the
issue with nested sort calls mentioned in gh #16129
@xenu
Copy link
Member

xenu commented Apr 30, 2020

PL_sort_RealCmp was removed by 044d25c so the issue is fixed.

@xenu xenu closed this as completed Apr 30, 2020
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

5 participants