-
Notifications
You must be signed in to change notification settings - Fork 0
/
test.lisp
134 lines (118 loc) · 5.07 KB
/
test.lisp
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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
(in-package :versioned-arrays)
(defpackage :versioned-arrays-test
(:use :cl :iter :modf :stefil :versioned-arrays)
(:export #:run-tests) )
(in-package :versioned-arrays-test)
(in-root-suite)
(defun run-tests ()
(2d-test)
(contention) )
(defsuite* :versioning)
(deftest term-by-term-equivalent-2d (a b &optional (test 'eql))
(is (equal (va-dimensions a) (va-dimensions b))
"Dimensionality mismatch" )
(iter (for i below (va-dimension a 0))
(iter (for j below (va-dimension a 1))
(is (funcall test (varef a i j) (varef b i j))) )))
(deftest 2d-test ()
(let* ((a1 (make-versioned-array
'(3 3) :initial-contents
'((1 2 3) (4 5 6) (7 8 9)) ))
(a1-same (make-versioned-array
'(3 3) :initial-contents
'((1 2 3) (4 5 6) (7 8 9)) ))
(a2 (modf (varef a1 0 0) -5))
(a3 (modf (varef a2 0 0) 1))
(a4 (modf (varef a2 1 1) -5) ))
(term-by-term-equivalent-2d a1 a1-same)
(term-by-term-equivalent-2d a1 a3)
;; call on a4. This modifies the structure.
(varef a4 2 2)
(term-by-term-equivalent-2d a1 a3) ))
(defsuite* :thread-safety)
(deftest contention ()
#+threads-support
(let* ((arr (make-versioned-array
'(3 3) :initial-contents
'((1 2 3) (4 5 6) (7 8 9)) ))
(new-arr arr) )
(iter (for i below 1000)
(let* ((rani (random 3))
(ranj (random 3))
(curr-value (varef arr rani ranj))
(ran-val (random 10)) )
(setf new-arr (modf (varef new-arr rani ranj) ran-val))
(setf new-arr (modf (varef new-arr rani ranj) curr-value)) ))
;; Now we have two arrays with a large delta between them.
(bt:make-thread (lambda () (iter (for i below 100)
(varef arr (random 3) (random 3)) )))
(bt:make-thread (lambda () (iter (for i below 100)
(varef new-arr (random 3) (random 3)) )))
(term-by-term-equivalent-2d arr new-arr) ))
(defsuite* :timing)
(defun place-queen (board i j)
"This complicated bit is to test if a queen can attack another."
(if (and (iter (for k from 0 below (va-dimension board 0))
(never (and (/= i k) (varef board k j))) )
(iter (for k from 0 below (va-dimension board 1))
(never (and (/= j k) (varef board i k))) )
(iter (for k1 from i downto 0)
(for k2 from j downto 0)
(never (and (/= k1 i) (/= k2 j) (varef board k1 k2))) )
(iter (for k1 from i below (va-dimension board 0))
(for k2 from j below (va-dimension board 1))
(never (and (/= k1 i) (/= k2 j) (varef board k1 k2))) )
(iter (for k1 from i downto 0)
(for k2 from j below (va-dimension board 1))
(never (and (/= k1 i) (/= k2 j) (varef board k1 k2))) )
(iter (for k1 from i below (va-dimension board 0))
(for k2 from j downto 0)
(never (and (/= k1 i) (/= k2 j) (varef board k1 k2))) ))
(modf (varef board i j) t)
nil ))
(defun n-queens (board n row)
"Simple enough backtracking algorithm."
(if (= row n)
board
(iter (for i below n)
(let ((result (place-queen board i row)))
(when result
(thereis (n-queens result n (+ row 1))) )))))
(defun place-queen* (board i j)
"This complicated bit is to test if a queen can attack another."
(if (and (iter (for k from 0 below (array-dimension board 0))
(never (and (/= i k) (aref board k j))) )
(iter (for k from 0 below (array-dimension board 1))
(never (and (/= j k) (aref board i k))) )
(iter (for k1 from i downto 0)
(for k2 from j downto 0)
(never (and (/= k1 i) (/= k2 j) (aref board k1 k2))) )
(iter (for k1 from i below (array-dimension board 0))
(for k2 from j below (array-dimension board 1))
(never (and (/= k1 i) (/= k2 j) (aref board k1 k2))) )
(iter (for k1 from i downto 0)
(for k2 from j below (array-dimension board 1))
(never (and (/= k1 i) (/= k2 j) (aref board k1 k2))) )
(iter (for k1 from i below (array-dimension board 0))
(for k2 from j downto 0)
(never (and (/= k1 i) (/= k2 j) (aref board k1 k2))) ))
t
nil ))
(defun n-queens* (board n row)
"A bit more convoluted backtracking algorithm."
(if (= row n)
board
(let (winning-board)
(iter (for i below n)
(let ((result (place-queen* board i row)))
(when result
(setf (aref board i row) t)
(let ((try (n-queens* board n (+ row 1))))
(when try
(setf winning-board try)
(finish) )
(setf (aref board i row) nil) ))
(finally (return winning-board)) )))))
(defun timing-test ()
"Maybe I can put in a test that makes sure things are scaling right?"
() )