From 59c3171c395544caab65938d3da5b9fee88aa444 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sat, 11 May 2013 13:39:36 +0900 Subject: [PATCH] Partition needs to split on <= to handle dups properly. --- lib/srfi/95/qsort.c | 4 +++- tests/sort-tests.scm | 12 ++++++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/lib/srfi/95/qsort.c b/lib/srfi/95/qsort.c index 439e185c..df8f0fc4 100644 --- a/lib/srfi/95/qsort.c +++ b/lib/srfi/95/qsort.c @@ -144,7 +144,7 @@ static void sexp_qsort (sexp ctx, sexp *vec, sexp_sint_t lo, sexp_sint_t hi) { /* partition */ for (i=j=lo; i < hi; i++) { diff = sexp_object_compare(ctx, vec[i], tmp); - if (diff < 0) { + if (diff <= 0) { swap(tmp2, vec[i], vec[j]); j++; } else if (diff == 0) { @@ -182,6 +182,7 @@ static sexp sexp_qsort_less (sexp ctx, sexp *vec, } else { b = tmp; } + /* partition */ for (i=j=lo; i < hi; i++) { if (sexp_truep(key)) { sexp_car(args1) = vec[i]; @@ -204,6 +205,7 @@ static sexp sexp_qsort_less (sexp ctx, sexp *vec, } } swap(tmp, vec[j], vec[hi]); + /* recurse */ res = sexp_qsort_less(ctx, vec, lo, j-1, less, key); if (sexp_exceptionp(res)) goto done; diff --git a/tests/sort-tests.scm b/tests/sort-tests.scm index 728a987f..6123a158 100644 --- a/tests/sort-tests.scm +++ b/tests/sort-tests.scm @@ -87,6 +87,18 @@ 0.0066999999999986) <)) +(test "sort watson no dups" + '#(-0.3096 -0.307000000000002 -0.303800000000003 -0.301600000000001 + -0.300599999999999 -0.3003 -0.3002 -0.2942) + (sort '#(-0.3096 -0.307000000000002 -0.303800000000003 -0.301600000000001 + -0.300599999999999 -0.2942 -0.3003 -0.3002))) + +(test "sort watson" + '#(-0.3096 -0.307000000000002 -0.303800000000003 -0.301600000000001 + -0.300599999999999 -0.3003 -0.3003 -0.3002 -0.2942) + (sort '#(-0.3096 -0.307000000000002 -0.303800000000003 -0.301600000000001 + -0.300599999999999 -0.2942 -0.3003 -0.3003 -0.3002))) + (test "sort ratios" '(1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5) (sort '(1/2 1/3 1/4 1/5 2/3 3/4 2/5 3/5 4/5)))