blob: 8f51dfa37b46fd65d117f22347a213fba963b4b5 (
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
89
90
91
92
93
94
95
96
97
98
|
(import (scheme base)
(only (csc sort) sort)
(only (csc testing)
define-test
errorf
subtest)
(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-test (test-hash-map->alist t)
(define-record-type <test-case>
(test-case desc vals)
test-case?
(desc desc)
(vals vals))
(let ((tests (list
(test-case
"singleton"
'((a . 1)))
(test-case
"two"
'((a . 1) (b . 2)))
(test-case
"longer"
'((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6))))))
(for-each
(lambda (tc)
(subtest t (desc tc)
(let* ((m (alist->hash-map hash-symbol symbol<? (vals tc)))
(got (hash-map->alist m)))
(unless (equal?
(sort
(lambda (x1 x2) (symbol<? (car x1) (car x2)))
got)
(sort
(lambda (x1 x2) (symbol<? (car x1) (car x2)))
(vals tc)))
(errorf t "(hash-map->alist {}) = {}, want {}." m got (vals tc))))))
tests)))
(define-test (test-alist->hash-map t)
(define-record-type <test-case>
(test-case desc vals want)
test-case?
(desc desc)
(vals vals)
(want want))
(let ((tests (list
(test-case
"singleton"
'((a . 1))
'((a . 1)))
(test-case
"two"
'((a . 1) (b . 2))
'((a . 1) (b . 2)))
(test-case
"larger"
'((m . 1) (n . 2) (q . 3) (f . 5) (n . 7) (x . 8))
'((f . 5) (m . 1) (n . 7) (q . 3) (x . 8)))
(test-case
"in-order"
'((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()))
'((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ())))
(test-case
"reversed"
'((h . ()) (g . ()) (f . ()) (e . ()) (d . ()) (c . ()) (b . ()) (a . ()))
'((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ())))
(test-case
"overwrite"
'((a . 1) (a . 2))
'((a . 2)))
(test-case
"alternating"
'((h . ()) (g . ()) (i . ()) (f . ()) (j . ()) (e . ()) (k . ()) (d . ()) (l . ()) (c . ()))
'((c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()) (i . ()) (j . ()) (k . ()) (l . ()))))))
(for-each
(lambda (tc)
(subtest t (desc tc)
(let ((got (alist->hash-map hash-symbol symbol<? (vals tc))))
(unless (equal?
(sort
(lambda (x1 x2) (symbol<? (car x1) (car x2)))
(hash-map->alist got))
(sort
(lambda (x1 x2) (symbol<? (car x1) (car x2)))
(want tc)))
(errorf t "(alist->hash-map {}) = {}, want {}." (vals tc) (hash-map->alist got) (want tc))))))
tests)))
|
