blob: 677406ec7ad631b88f1d8d84844d2a8203492362 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
(import (scheme base)
(only (csc sort) sort)
(only (csc testing)
assert-equal
assert-raises
test)
(csc hash-map))
(define (hash-symbol s)
(hash-bytevector (string->utf8 (symbol->string s))))
(define (symbol<? s1 s2)
(string<? (symbol->string s1) (symbol->string s2)))
(define (alist->map->alist l)
(map->alist (alist->map hash-symbol symbol<? l)))
(define (sort-alist l)
(sort (lambda (x1 x2) (symbol<? (car x1) (car x2))) l))
(test map->alist-singleton
(assert-equal (sort-alist '((a . 1))) (sort-alist (alist->map->alist '((a . 1))))))
(test map->alist-two
(assert-equal (sort-alist '((a . 1) (b . 2))) (sort-alist (alist->map->alist '((a . 1) (b . 2))))))
(test map->alist-longer
(assert-equal
(sort-alist '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6)))
(sort-alist (alist->map->alist '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6))))))
(test map->alist-larger
(assert-equal
(sort-alist '((f . 5) (m . 1) (n . 7) (q . 3) (x . 8)))
(sort-alist (alist->map->alist '((m . 1) (n . 2) (q . 3) (f . 5) (n . 7) (x . 8))))))
(test map->alist-in-order
(assert-equal
(sort-alist '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ())))
(sort-alist (alist->map->alist '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()))))))
(test map->alist-reversed
(assert-equal
(sort-alist '((h . ()) (g . ()) (f . ()) (e . ()) (d . ()) (c . ()) (b . ()) (a . ())))
(sort-alist (alist->map->alist '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()))))))
(test map->alist-overwrite
(assert-equal
(sort-alist '((a . 2)))
(sort-alist (alist->map->alist '((a . 1) (a . 2))))))
(test map->alist-alternating
(assert-equal
(sort-alist '((h . ()) (g . ()) (i . ()) (f . ()) (j . ()) (e . ()) (k . ()) (d . ()) (l . ()) (c . ())))
(sort-alist (alist->map->alist '((c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()) (i . ()) (j . ()) (k . ()) (l . ()))))))
(test lookup
(assert-equal
2
(lookup (alist->map hash-symbol symbol<? '((a . 1) (b . 2) (c . 3))) 'b)))
(test lookup-notfound
(assert-raises key-not-found-error?
(lookup (alist->map hash-symbol symbol<? '((a . 1) (b . 2) (c . 3))) 'd)))
(test merge
(assert-equal
(sort-alist '((a . 1) (b . 2) (c . 3) (d . 4)))
(sort-alist
(map->alist
(merge
(alist->map hash-symbol symbol<? '((a . 1) (b . 2)))
(alist->map hash-symbol symbol<? '((c . 3) (d . 4))))))))
|
