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
|
(in-package #:metabang-bind-test)
(defstruct (metabang-bind-test-1)
a
b
c)
(defstruct (metabang-bind-test-2 (:conc-name bind-test-))
d
e)
(deftestsuite test-structures (metabang-bind-test)
())
(addtest (test-structures)
basic-access
(ensure-same
(bind (((:struct metabang-bind-test-1- a c)
(make-metabang-bind-test-1 :a 1 :b 2 :c 3)))
(list a c))
'(1 3) :test 'equal))
(addtest (test-structures)
no-capture
(let ((values 4))
(bind (((:struct metabang-bind-test-1- a c)
(make-metabang-bind-test-1 :a 1 :b 2 :c 3)))
(ensure-same '(4 1 3) (list values a c) :test 'equal))))
(addtest (test-structures)
changed-variable-name
(ensure-same
(bind (((:struct metabang-bind-test-1- (my-a a) c)
(make-metabang-bind-test-1 :a 1 :b 2 :c 3)))
(list c my-a))
'(3 1) :test 'equal))
(addtest (test-structures)
changed-variable-name-2
(ensure-same
(bind (((:structure metabang-bind-test-1- (my-a a) c)
(make-metabang-bind-test-1 :a 1 :b 2 :c 3)))
(list c my-a))
'(3 1) :test 'equal))
(addtest (test-structures)
nested-read-only
(let ((c1 (make-metabang-bind-test-1 :a 1 :b 2 :c 3))
(c2 (make-metabang-bind-test-1 :a 4 :b 5 :c 6)))
(ensure-same
(bind (((:structure metabang-bind-test-1- (my-a a) c) c1)
((:structure metabang-bind-test-1- a b (second-c c)) c2))
(list my-a c a b second-c))
'(1 3 4 5 6) :test 'equal)))
(addtest (test-structures)
read-write-nested
(let ((c1 (make-metabang-bind-test-1 :a 1 :b 2 :c 3))
(c2 (make-metabang-bind-test-1 :a 4 :b 5 :c 6)))
(bind (((:structure/rw metabang-bind-test-1- (my-a a) c) c1)
((:structure/rw metabang-bind-test-1- a b (second-c c)) c2))
(setf my-a :a second-c :c b :b))
(ensure-same (metabang-bind-test-1-a c1) :a)
(ensure-same (metabang-bind-test-1-b c2) :b)
(ensure-same (metabang-bind-test-1-c c2) :c)))
|
