Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-05 04:06:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

fixing sort bug

Browse source
This commit is contained in:
Alex Shinn 2011-05-29 18:46:54 +09:00
parent 7b3aeebbd3
commit b819a99b7b
2 changed files with 9 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
lib/srfi/95/qsort.c
View file

@ -1,5 +1,5 @@
/* qsort.c -- quicksort implementation */ /* 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 */ /* BSD-style license: http://synthcode.com/license.txt */
#include "chibi/eval.h" #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) if (sexp_object_compare(ctx, vec[i], tmp) < 0)
swap(tmp2, vec[i], vec[j]), j++; swap(tmp2, vec[i], vec[j]), j++;
swap(tmp, vec[j], vec[hi]); 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; lo = j;
goto loop; /* tail recurse on right side */ 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(res, vec[i], vec[j]), j++;
} }
swap(tmp, vec[j], vec[hi]); swap(tmp, vec[j], vec[hi]);
if ((hi-lo) > 2) { res = sexp_qsort_less(ctx, vec, lo, j-1, less, key);
res = sexp_qsort_less(ctx, vec, lo, j-1, less, key); if (sexp_exceptionp(res))
if (sexp_exceptionp(res)) goto done;
goto done; if (j < hi-1) {
lo = j; lo = j;
goto loop; /* tail recurse on right side */ goto loop; /* tail recurse on right side */
} }

2
tests/sort-tests.scm
View file

@ -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 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 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 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) (test "sort numeric list <" '(1 2 3 4 5 6 7 8 9)
(sort '(7 5 2 8 1 6 4 9 3) <)) (sort '(7 5 2 8 1 6 4 9 3) <))
(test "sort numeric list < car" '((1) (2) (3) (4) (5) (6) (7) (8) (9)) (test "sort numeric list < car" '((1) (2) (3) (4) (5) (6) (7) (8) (9))