Commit | Line | Data |
---|---|---|
8794d769 JG |
1 | ;;; arithmetic-fixnums.test --- Test suite for R6RS (rnrs arithmetic bitwise) |
2 | ||
a1c9ecf0 | 3 | ;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc. |
8794d769 JG |
4 | ;; |
5 | ;; This library is free software; you can redistribute it and/or | |
6 | ;; modify it under the terms of the GNU Lesser General Public | |
7 | ;; License as published by the Free Software Foundation; either | |
8 | ;; version 3 of the License, or (at your option) any later version. | |
9 | ;; | |
10 | ;; This library is distributed in the hope that it will be useful, | |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;; Lesser General Public License for more details. | |
14 | ;; | |
15 | ;; You should have received a copy of the GNU Lesser General Public | |
16 | ;; License along with this library; if not, write to the Free Software | |
17 | ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
18 | \f | |
19 | ||
20 | (define-module (test-suite test-r6rs-arithmetic-fixnums) | |
21 | :use-module ((rnrs arithmetic fixnums) :version (6)) | |
22 | :use-module ((rnrs conditions) :version (6)) | |
23 | :use-module ((rnrs exceptions) :version (6)) | |
24 | :use-module (test-suite lib)) | |
25 | ||
06903786 MW |
26 | (with-test-prefix "fixnum-width" |
27 | (pass-if-equal "consistent with least-fixnum" | |
28 | (- (expt 2 (- (fixnum-width) 1))) | |
29 | (least-fixnum)) | |
30 | (pass-if-equal "consistent with greatest-fixnum" | |
31 | (- (expt 2 (- (fixnum-width) 1)) 1) | |
32 | (greatest-fixnum))) | |
33 | ||
8794d769 JG |
34 | (with-test-prefix "fixnum?" |
35 | (pass-if "fixnum? is #t for fixnums" (fixnum? 0)) | |
36 | ||
37 | (pass-if "fixnum? is #f for non-fixnums" (not (fixnum? 'foo))) | |
38 | ||
39 | (pass-if "fixnum? is #f for non-fixnum numbers" | |
40 | (and (not (fixnum? 1.0)) (not (fixnum? (+ (greatest-fixnum) 1)))))) | |
41 | ||
42 | (with-test-prefix "fx=?" | |
43 | (pass-if "fx=? is #t for eqv inputs" (fx=? 3 3 3)) | |
44 | ||
45 | (pass-if "fx=? is #f for non-eqv inputs" (not (fx=? 1 2 3)))) | |
46 | ||
47 | (with-test-prefix "fx>?" | |
48 | (pass-if "fx>? is #t for monotonically > inputs" (fx>? 3 2 1)) | |
49 | ||
50 | (pass-if "fx>? is #f for non-monotonically > inputs" (not (fx>? 1 2 3)))) | |
51 | ||
52 | (with-test-prefix "fx<?" | |
53 | (pass-if "fx<? is #t for monotonically < inputs" (fx<? 1 2 3)) | |
54 | ||
55 | (pass-if "fx<? is #t for non-monotonically < inputs" (not (fx<? 3 2 1)))) | |
56 | ||
57 | (with-test-prefix "fx>=?" | |
58 | (pass-if "fx>=? is #t for monotonically > or = inputs" (fx>=? 3 2 2 1)) | |
59 | ||
60 | (pass-if "fx>=? is #f for non-monotonically > or = inputs" | |
61 | (not (fx>=? 1 2 3)))) | |
62 | ||
63 | (with-test-prefix "fx<=?" | |
64 | (pass-if "fx<=? is #t for monotonically < or = inputs" (fx<=? 1 2 2 3)) | |
65 | ||
66 | (pass-if "fx<=? is #f for non-monotonically < or = inputs" | |
67 | (not (fx<=? 3 2 1)))) | |
68 | ||
69 | (with-test-prefix "fxzero?" | |
70 | (pass-if "fxzero? is #t for zero" (fxzero? 0)) | |
71 | ||
72 | (pass-if "fxzero? is #f for non-zero fixnums" | |
73 | (and (not (fxzero? 1)) (not (fxzero? -1))))) | |
74 | ||
75 | (with-test-prefix "fxpositive?" | |
76 | (pass-if "fxpositive? is #t for positive fixnums" (fxpositive? 1)) | |
77 | ||
78 | (pass-if "fxpositive? is #f for non-positive fixnums" | |
79 | (and (not (fxpositive? -1)) | |
80 | (not (fxpositive? 0))))) | |
81 | ||
82 | (with-test-prefix "fxnegative?" | |
83 | (pass-if "fxnegative? is #t for negative fixnums" (fxnegative? -1)) | |
84 | ||
85 | (pass-if "fxnegative? is #f for non-negative fixnums" | |
86 | (and (not (fxnegative? 1)) | |
87 | (not (fxnegative? 0))))) | |
88 | ||
89 | (with-test-prefix "fxodd?" | |
90 | (pass-if "fxodd? is #t for odd fixnums" (fxodd? 1)) | |
91 | ||
92 | (pass-if "fxodd? is #f for even fixnums" (not (fxodd? 2)))) | |
93 | ||
94 | (with-test-prefix "fxeven?" | |
95 | (pass-if "fxeven? is #t for even fixnums" (fxeven? 2)) | |
96 | ||
97 | (pass-if "fxeven? is #f for odd fixnums" (not (fxeven? 1)))) | |
98 | ||
99 | (with-test-prefix "fxmax" (pass-if "simple" (fx=? (fxmax 1 3 2) 3))) | |
100 | ||
101 | (with-test-prefix "fxmin" (pass-if "simple" (fx=? (fxmin -1 0 2) -1))) | |
102 | ||
103 | (with-test-prefix "fx+" | |
104 | (pass-if "simple" (fx=? (fx+ 1 2) 3)) | |
105 | ||
106 | (pass-if "&implementation-restriction on non-fixnum result" | |
107 | (guard (condition ((implementation-restriction-violation? condition) #t) | |
108 | (else #f)) | |
109 | (begin (fx+ (greatest-fixnum) 1) #f)))) | |
110 | ||
111 | (with-test-prefix "fx*" | |
112 | (pass-if "simple" (fx=? (fx* 2 3) 6)) | |
113 | ||
114 | (pass-if "&implementation-restriction on non-fixnum result" | |
115 | (guard (condition ((implementation-restriction-violation? condition) #t) | |
116 | (else #f)) | |
117 | (begin (fx* (greatest-fixnum) 2) #f)))) | |
118 | ||
119 | (with-test-prefix "fx-" | |
120 | (pass-if "unary fx- negates argument" (fx=? (fx- 1) -1)) | |
121 | ||
122 | (pass-if "simple" (fx=? (fx- 3 2) 1)) | |
123 | ||
124 | (pass-if "&assertion on non-fixnum result" | |
125 | (guard (condition ((assertion-violation? condition) #t) (else #f)) | |
126 | (fx- (least-fixnum) 1)))) | |
127 | ||
128 | (with-test-prefix "fxdiv-and-mod" | |
129 | (pass-if "simple" | |
130 | (call-with-values (lambda () (fxdiv-and-mod 123 10)) | |
131 | (lambda (d m) | |
ff62c168 | 132 | (and (fx=? d 12) (fx=? m 3)))))) |
8794d769 | 133 | |
ff62c168 MW |
134 | (with-test-prefix "fxdiv" (pass-if "simple" (fx=? (fxdiv -123 10) -13))) |
135 | (with-test-prefix "fxmod" (pass-if "simple" (fx=? (fxmod -123 10) 7))) | |
8794d769 JG |
136 | |
137 | (with-test-prefix "fxdiv0-and-mod0" | |
138 | (pass-if "simple" | |
139 | (call-with-values (lambda () (fxdiv0-and-mod0 -123 10)) | |
140 | (lambda (d m) | |
ff62c168 | 141 | (and (fx=? d -12) (fx=? m -3)))))) |
8794d769 | 142 | |
ff62c168 MW |
143 | (with-test-prefix "fxdiv0" (pass-if "simple" (fx=? (fxdiv0 -123 10) -12))) |
144 | (with-test-prefix "fxmod0" (pass-if "simple" (fx=? (fxmod0 -123 10) -3))) | |
8794d769 JG |
145 | |
146 | ||
147 | ;; Without working div and mod implementations and without any example results | |
148 | ;; from the spec, I have no idea what the results of these functions should | |
149 | ;; be. -juliang | |
ff62c168 | 150 | ;; UPDATE: div and mod implementations are now working properly -mhw |
8794d769 JG |
151 | |
152 | (with-test-prefix "fx+/carry" (pass-if "simple" (throw 'unresolved))) | |
153 | ||
154 | (with-test-prefix "fx-/carry" (pass-if "simple" (throw 'unresolved))) | |
155 | ||
156 | (with-test-prefix "fx*/carry" (pass-if "simple" (throw 'unresolved))) | |
157 | ||
158 | (with-test-prefix "fxnot" (pass-if "simple" (fx=? (fxnot 3) -4))) | |
159 | ||
160 | (with-test-prefix "fxand" (pass-if "simple" (fx=? (fxand 5 6) 4))) | |
161 | ||
162 | (with-test-prefix "fxior" (pass-if "simple" (fx=? (fxior 2 4) 6))) | |
163 | ||
164 | (with-test-prefix "fxxor" (pass-if "simple" (fx=? (fxxor 5 4) 1))) | |
165 | ||
166 | (with-test-prefix "fxif" (pass-if "simple" (fx=? (fxif 5 3 4) 1))) | |
167 | ||
a1c9ecf0 MW |
168 | (with-test-prefix "fxbit-count" |
169 | (pass-if "simple" (fx=? (fxbit-count 5) 2)) | |
170 | (pass-if "negative" (fx=? (fxbit-count -5) -2))) | |
8794d769 JG |
171 | |
172 | (with-test-prefix "fxlength" (pass-if "simple" (fx=? (fxlength 5) 3))) | |
173 | ||
174 | (with-test-prefix "fxfirst-bit-set" | |
175 | (pass-if "simple" | |
176 | (and (eqv? (fxfirst-bit-set 1) 0) | |
177 | (eqv? (fxfirst-bit-set -4) 2))) | |
178 | ||
179 | (pass-if "fxfirst-bit-set is -1 on zero" | |
180 | (and (eqv? (fxfirst-bit-set 0) -1)))) | |
181 | ||
182 | (with-test-prefix "fxbit-set?" | |
183 | (pass-if "fxbit-set? is #t on index of set bit" (fxbit-set? 5 2)) | |
184 | ||
185 | (pass-if "fxbit-set? is #f on index of unset bit" (not (fxbit-set? 5 1)))) | |
186 | ||
93da406f | 187 | (with-test-prefix "fxcopy-bit" (pass-if "simple" (fx=? (fxcopy-bit 2 2 1) 6))) |
8794d769 JG |
188 | |
189 | (with-test-prefix "fxbit-field" | |
190 | (pass-if "simple" (fx=? (fxbit-field 50 1 4) 1))) | |
191 | ||
192 | (with-test-prefix "fxcopy-bit-field" | |
193 | (pass-if "simple" (fx=? (fxcopy-bit-field 255 2 6 10) 235))) | |
194 | ||
195 | (with-test-prefix "fxarithmetic-shift" | |
196 | (pass-if "simple" | |
197 | (and (fx=? (fxarithmetic-shift -6 -1) -3) | |
198 | (fx=? (fxarithmetic-shift -5 -1) -3) | |
199 | (fx=? (fxarithmetic-shift -4 -1) -2) | |
200 | (fx=? (fxarithmetic-shift -3 -1) -2) | |
201 | (fx=? (fxarithmetic-shift -2 -1) -1) | |
202 | (fx=? (fxarithmetic-shift -1 -1) -1)))) | |
203 | ||
204 | (with-test-prefix "fxarithmetic-shift-left" | |
205 | (pass-if "simple" (fx=? (fxarithmetic-shift-left -6 -1) -3))) | |
206 | ||
207 | (with-test-prefix "fxarithmetic-shift-right" | |
208 | (pass-if "simple" (fx=? (fxarithmetic-shift-right -6 1) -3))) | |
209 | ||
210 | (with-test-prefix "fxrotate-bit-field" | |
211 | (pass-if "simple" (fx=? (fxrotate-bit-field 227 2 6 2) 203))) | |
212 | ||
213 | (with-test-prefix "fxreverse-bit-field" | |
214 | (pass-if "simple" (fx=? (fxreverse-bit-field 82 1 4) 88))) |