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

Fixing bug in iset-adjoin for values already present at a node boundary.

Browse source
This commit is contained in:
Alex Shinn 2013-11-09 16:35:22 +09:00
parent c0619b769d
commit d2bd4d6d44
2 changed files with 9 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lib/chibi/iset/constructors.scm
View file

@ -81,7 +81,7 @@
(if (let* ((left (iset-left iset)) (if (let* ((left (iset-left iset))
(m-end (and left (iset-max-end left)))) (m-end (and left (iset-max-end left))))
(and m-end (and m-end
(or (< n m-end) (or (<= n m-end)
(< (- n m-end) s-diff)))) (< (- n m-end) s-diff))))
(iset-adjoin1! (iset-left iset) n) (iset-adjoin1! (iset-left iset) n)
(cond (cond
@ -98,7 +98,7 @@
(if (let* ((right (iset-right iset)) (if (let* ((right (iset-right iset))
(m-start (and right (iset-min-start right)))) (m-start (and right (iset-min-start right))))
(and m-start (and m-start
(or (> n m-start) (or (>= n m-start)
(> (- n m-start) e-diff)))) (> (- n m-start) e-diff))))
(iset-adjoin1! (iset-right iset) n) (iset-adjoin1! (iset-right iset) n)
(cond (cond

11
tests/iset-tests.scm
View file

@ -1,6 +1,7 @@
(cond-expand (cond-expand
(modules (import (chibi iset) (chibi iset optimize) (srfi 1) (chibi test))) (modules
(import (chibi) (chibi iset) (chibi iset optimize) (srfi 1) (chibi test)))
(else #f)) (else #f))
(test-begin "iset") (test-begin "iset")
@ -15,6 +16,7 @@
((0 1 2) (- 1) (- 2) (? 0)) ((0 1 2) (- 1) (- 2) (? 0))
((1 2 3 1000 2000) (u 1 4)) ((1 2 3 1000 2000) (u 1 4))
((1 2 3 1000 1005)) ((1 2 3 1000 1005))
((97308 97827 97845 97827))
((1 128 127)) ((1 128 127))
((129 2 127)) ((129 2 127))
((1 -128 -126)) ((1 -128 -126))
@ -25,10 +27,11 @@
(for-each (for-each
(lambda (tst) (lambda (tst)
(let* ((ls (car tst)) (let* ((ls (car tst))
(is (list->iset ls))) (is (list->iset ls))
(ls2 (delete-duplicates ls =)))
;; initial creation and sanity checks ;; initial creation and sanity checks
(test-assert (lset= equal? ls (iset->list is))) (test-assert (lset= equal? ls2 (iset->list is)))
(test (length ls) (iset-size is)) (test (length ls2) (iset-size is))
(for-each (for-each
(lambda (x) (test-assert (iset-contains? is x))) (lambda (x) (test-assert (iset-contains? is x)))
ls) ls)