~ chicken-core (chicken-5) /tests/data-structures-tests.scm

  1;;;; data-structures-tests.scm
  2
  3(import (chicken sort)
  4	(chicken string))
  5
  6(define-syntax assert-error
  7  (syntax-rules ()
  8    ((_ expr)
  9     (assert (handle-exceptions _ #t expr #f)))))
 10
 11(assert (equal? 'bar (alist-ref 'foo '((foo . bar)))))
 12(assert (not (alist-ref 'foo '())))
 13(assert (not (alist-ref 'foo '((bar . foo)))))
 14(assert-error (alist-ref 'foo 'bar))
 15(assert-error (alist-ref 'foo '(bar)))
 16
 17(let ((cmp (lambda (x y) (eqv? x y))))
 18  (assert (equal? 'bar (alist-ref 'foo '((foo . bar)) cmp)))
 19  (assert (not (alist-ref 'foo '() cmp)))
 20  (assert (not (alist-ref 'foo '((bar . foo)) cmp)))
 21  (assert-error (alist-ref 'foo 'bar cmp))
 22  (assert-error (alist-ref 'foo '(bar) cmp)))
 23
 24
 25(let ((alist '((foo . 123) ("bar" . "baz"))))
 26  (alist-update! 'foo 999 alist)
 27  (assert (= (alist-ref 'foo alist) 999))
 28  (alist-update! 'qux 'nope alist)
 29  (assert (not (alist-ref 'qux alist)))
 30  (assert (eq? 'yep (alist-ref 'qux (alist-update! 'qux 'yep alist))))
 31  (assert (eq? 'ok (alist-ref "bar" (alist-update! "bar" 'ok alist equal?) equal?))))
 32
 33(let ((alist '((foo . 123) ("bar" . "baz"))))
 34  (alist-update 'foo 999 alist)
 35  (assert (= (alist-ref 'foo alist) 123))
 36  (assert (eq? 'yep (alist-ref 'qux (alist-update 'qux 'yep alist))))
 37  (assert (eq? 'ok (alist-ref "bar" (alist-update "bar" 'ok alist equal?) equal?))))
 38
 39;; #808: strings with embedded nul bytes should not be compared
 40;; with ASCIIZ string comparison functions
 41(assert (substring=? "foo\x00a" "foo\x00a" 1 1))
 42(assert (substring-ci=? "foo\x00a" "foo\x00a" 1 1))
 43(assert (substring-ci=? "foo\x00a" "foo\x00A" 1 1))
 44(assert (= 2 (substring-index "o\x00bar" "foo\x00bar")))
 45(assert (= 2 (substring-index-ci "o\x00bar" "foo\x00bar")))
 46(assert (= 2 (substring-index-ci "o\x00bar" "foo\x00BAR")))
 47(assert (not (substring=? "foo\x00a" "foo\x00b" 1 1)))
 48(assert (not (substring-ci=? "foo\x00a" "foo\x00b" 1 1)))
 49(assert (substring=? "" "" 0 0 0))
 50(assert (substring-ci=? "" "" 0 0 0))
 51(assert (substring=? "" "abc"))
 52(assert (substring-ci=? "" "abc"))
 53(assert (substring=? "abc" ""))
 54(assert (substring-ci=? "abc" ""))
 55(assert-error (substring=? "" "" 0 0 1))
 56(assert-error (substring-ci=? "" "" 0 0 1))
 57(assert (substring=? "foo" "foo" 0 0 3))
 58(assert (substring-ci=? "foo" "foo" 0 0 3))
 59(assert (not (substring-index "o\x00bar" "foo\x00baz")))
 60(assert (not (substring-index-ci "o\x00bar" "foo\x00baz")))
 61(assert (= 0 (substring-index "" "")))
 62(assert (= 1 (substring-index "" "a" 1)))
 63(assert-error (substring=? "a" "a" 2))
 64(assert-error (substring=? "a" "a" -2))
 65(assert-error (substring=? "a" "a" 0 2))
 66(assert-error (substring=? "a" "a" 0 -2))
 67(assert-error (substring=? "a" "a" 0 0 2))
 68(assert-error (substring=? "a" "a" 0 0 -2))
 69(assert-error (substring-ci=? "a" "a" 2))
 70(assert-error (substring-ci=? "a" "a" -2))
 71(assert-error (substring-ci=? "a" "a" 0 2))
 72(assert-error (substring-ci=? "a" "a" 0 -2))
 73(assert-error (substring-ci=? "a" "a" 0 0 2))
 74(assert-error (substring-ci=? "a" "a" 0 0 -2))
 75(assert-error (substring-ci=? "a" "a" 0 0 2))
 76(assert-error (substring-index "" "a" 2))
 77(assert-error (substring-index "a" "b" 2))
 78(assert (not (substring-index "a" "b" 1)))
 79(assert (not (substring-index "ab" "")))
 80(assert (= 0 (string-compare3 "foo\x00a" "foo\x00a")))
 81(assert (> 0 (string-compare3 "foo\x00a" "foo\x00b")))
 82(assert (< 0 (string-compare3 "foo\x00b" "foo\x00a")))
 83(assert (= 0 (string-compare3-ci "foo\x00a" "foo\x00a")))
 84(assert (= 0 (string-compare3-ci "foo\x00a" "foo\x00A")))
 85(assert (> 0 (string-compare3-ci "foo\x00a" "foo\x00b")))
 86(assert (> 0 (string-compare3-ci "foo\x00A" "foo\x00b")))
 87(assert (< 0 (string-compare3-ci "foo\x00b" "foo\x00a")))
 88(assert (< 0 (string-compare3-ci "foo\x00b" "foo\x00A")))
 89
 90(assert (string=? "bde" (string-translate* "abcd"
 91					   '(("a" . "b")
 92					     ("b" . "")
 93					     ("c" . "d")
 94					     ("d" . "e")))))
 95(assert (string=? "bc" (string-translate* "abc"
 96					  '(("ab" . "b")
 97					    ("bc" . "WRONG")))))
 98(assert (string=? "x" (string-translate* "ab" '(("ab" . "x")))))
 99(assert (string=? "xy" (string-translate* "xyz" '(("z" . "")))))
100
101;; topological-sort
102
103(assert (equal? '() (topological-sort '() eq?)))
104(assert (equal? '(a b c d) (topological-sort '((a b) (b c) (c d)) eq?)))
105(assert (equal? '(a b c d) (topological-sort '((a b) (c d)) eq?)))
106(assert-error (topological-sort '((a b) (b a)) eq?))
107(assert 
108  (equal? 
109    (topological-sort
110     '((i am)
111       (not trying)
112       (confuse the)
113       (am trying)
114       (trying to)
115       (am not)
116       (trying the)
117       (to confuse)
118       (the issue))
119      eq?)
120    '(i am not trying to confuse the issue)))