From b819a99b7b01a56ccdb5085a7d509fd24c502330 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 29 May 2011 18:46:54 +0900 Subject: [PATCH] fixing sort bug --- lib/srfi/95/qsort.c | 14 +++++++------- tests/sort-tests.scm | 2 ++ 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/lib/srfi/95/qsort.c b/lib/srfi/95/qsort.c index a84a2b50..3c1c33d3 100644 --- a/lib/srfi/95/qsort.c +++ b/lib/srfi/95/qsort.c @@ -1,5 +1,5 @@ /* qsort.c -- quicksort implementation */ -/* Copyright (c) 2009-2010 Alex Shinn. All rights reserved. */ +/* Copyright (c) 2009-2011 Alex Shinn. All rights reserved. */ /* BSD-style license: http://synthcode.com/license.txt */ #include "chibi/eval.h" @@ -128,8 +128,8 @@ static void sexp_qsort (sexp ctx, sexp *vec, sexp_sint_t lo, sexp_sint_t hi) { if (sexp_object_compare(ctx, vec[i], tmp) < 0) swap(tmp2, vec[i], vec[j]), j++; swap(tmp, vec[j], vec[hi]); - if ((hi-lo) > 2) { - sexp_qsort(ctx, vec, lo, j-1); + sexp_qsort(ctx, vec, lo, j-1); + if (j < hi-1) { lo = j; goto loop; /* tail recurse on right side */ } @@ -173,10 +173,10 @@ static sexp sexp_qsort_less (sexp ctx, sexp *vec, swap(res, vec[i], vec[j]), j++; } swap(tmp, vec[j], vec[hi]); - if ((hi-lo) > 2) { - res = sexp_qsort_less(ctx, vec, lo, j-1, less, key); - if (sexp_exceptionp(res)) - goto done; + res = sexp_qsort_less(ctx, vec, lo, j-1, less, key); + if (sexp_exceptionp(res)) + goto done; + if (j < hi-1) { lo = j; goto loop; /* tail recurse on right side */ } diff --git a/tests/sort-tests.scm b/tests/sort-tests.scm index e54162fc..e2798ab1 100644 --- a/tests/sort-tests.scm +++ b/tests/sort-tests.scm @@ -13,6 +13,8 @@ (test "sort random list 1" '(1 2 3 4 5 6 7 8 9) (sort '(7 5 2 8 1 6 4 9 3))) (test "sort random list 2" '(1 2 3 4 5 6 7 8) (sort '(5 3 4 1 7 6 8 2))) (test "sort random list 3" '(1 2 3 4 5 6 7 8 9) (sort '(5 3 4 1 7 9 6 8 2))) +(test "sort short random list" '(1 2 3) (sort '(2 1 3))) +(test "sort short random list cmp" '(1 2 3) (sort '(2 1 3) (lambda (a b) (< a b)))) (test "sort numeric list <" '(1 2 3 4 5 6 7 8 9) (sort '(7 5 2 8 1 6 4 9 3) <)) (test "sort numeric list < car" '((1) (2) (3) (4) (5) (6) (7) (8) (9))