Commit | Line | Data |
---|---|---|
7673cf68 DH |
1 | ;;;; vectors.test --- test suite for Guile's vector functions -*- scheme -*- |
2 | ;;;; | |
99015f6d | 3 | ;;;; Copyright (C) 2003, 2006, 2010, 2011 Free Software Foundation, Inc. |
7673cf68 | 4 | ;;;; |
53befeb7 NJ |
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. | |
7673cf68 | 9 | ;;;; |
53befeb7 | 10 | ;;;; This library is distributed in the hope that it will be useful, |
7673cf68 | 11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
53befeb7 NJ |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13 | ;;;; Lesser General Public License for more details. | |
7673cf68 | 14 | ;;;; |
53befeb7 NJ |
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 | |
7673cf68 | 18 | |
22be72d3 LC |
19 | (define-module (test-suite vectors) |
20 | :use-module (test-suite lib)) | |
7673cf68 DH |
21 | |
22 | ;; FIXME: As soon as guile supports immutable vectors, this has to be | |
23 | ;; replaced with the appropriate error type and message. | |
24 | (define exception:immutable-vector | |
25 | (cons 'some-error-type "^trying to modify an immutable vector")) | |
26 | ||
27 | ||
28 | (with-test-prefix "vector-set!" | |
29 | ||
30 | (expect-fail-exception "vector constant" | |
31 | exception:immutable-vector | |
32 | (vector-set! '#(1 2 3) 0 4))) | |
22be72d3 LC |
33 | |
34 | (with-test-prefix "vector->list" | |
35 | ||
36 | (pass-if "simple vector" | |
37 | (equal? '(1 2 3) (vector->list #(1 2 3)))) | |
38 | ||
fee95176 MG |
39 | (pass-if "string vector 1" |
40 | (equal? '("abc" "def" "ghi") (vector->list #("abc" "def" "ghi")))) | |
41 | ||
42 | (pass-if "string-vector 2" | |
43 | (equal? '("abc\u0100" "def\u0101" "ghi\u0102") | |
44 | (vector->list #("abc\u0100" "def\u0101" "ghi\u0102")))) | |
45 | ||
22be72d3 LC |
46 | (pass-if "shared array" |
47 | (let ((b (make-shared-array #(1) (lambda (x) '(0)) 2))) | |
48 | (equal? b (list->vector (vector->list b)))))) | |
49 | ||
fee95176 MG |
50 | (with-test-prefix "make-vector" |
51 | ||
52 | (pass-if "null" | |
53 | (equal? #() (make-vector 0))) | |
54 | ||
55 | (pass-if "fill with num" | |
56 | (equal? #(1 1 1) (make-vector 3 1))) | |
57 | ||
58 | (pass-if "fill with string" | |
59 | (equal? #("abc" "abc" "abc") (make-vector 3 "abc"))) | |
60 | ||
61 | (pass-if "fill with string 2" | |
62 | (equal? #("ab\u0100" "ab\u0100" "ab\u0100") | |
63 | (make-vector 3 "ab\u0100")))) | |
64 | ||
551b96d2 AW |
65 | (with-test-prefix "vector-move-left!" |
66 | ||
67 | (pass-if-exception "before start" exception:out-of-range | |
68 | (let ((a (vector 1 2 3 4 5 6 7 8 9)) | |
69 | (b (vector 10 20 30 40 50 60 70 80 90))) | |
70 | (vector-move-left! a 3 5 b -1))) | |
71 | ||
72 | (pass-if "beginning" | |
73 | (let ((a (vector 1 2 3 4 5 6 7 8 9)) | |
74 | (b (vector 10 20 30 40 50 60 70 80 90))) | |
75 | (vector-move-left! a 3 5 b 0) | |
76 | (equal? b #(4 5 30 40 50 60 70 80 90)))) | |
77 | ||
78 | (pass-if "middle" | |
79 | (let ((a (vector 1 2 3 4 5 6 7 8 9)) | |
80 | (b (vector 10 20 30 40 50 60 70 80 90))) | |
81 | (vector-move-left! a 3 5 b 2) | |
82 | (equal? b #(10 20 4 5 50 60 70 80 90)))) | |
83 | ||
84 | (pass-if "overlap -" | |
85 | (let ((a (vector 1 2 3 4 5 6 7 8 9))) | |
86 | (vector-move-left! a 3 5 a 2) | |
87 | (equal? a #(1 2 4 5 5 6 7 8 9)))) | |
88 | ||
89 | (pass-if "overlap +" | |
90 | (let ((a (vector 1 2 3 4 5 6 7 8 9))) | |
91 | (vector-move-left! a 3 5 a 4) | |
92 | (equal? a #(1 2 3 4 4 4 7 8 9)))) | |
93 | ||
94 | (pass-if "end" | |
95 | (let ((a (vector 1 2 3 4 5 6 7 8 9)) | |
96 | (b (vector 10 20 30 40 50 60 70 80 90))) | |
97 | (vector-move-left! a 3 5 b 7) | |
98 | (equal? b #(10 20 30 40 50 60 70 4 5)))) | |
99 | ||
99015f6d AW |
100 | (pass-if "whole thing" |
101 | (let ((a (vector 1 2 3 4 5 6 7 8 9)) | |
102 | (b (vector 10 20 30 40 50 60 70 80 90))) | |
103 | (vector-move-left! a 0 9 b 0) | |
104 | (equal? b #(1 2 3 4 5 6 7 8 9)))) | |
105 | ||
551b96d2 AW |
106 | (pass-if-exception "past end" exception:out-of-range |
107 | (let ((a (vector 1 2 3 4 5 6 7 8 9)) | |
108 | (b (vector 10 20 30 40 50 60 70 80 90))) | |
109 | (vector-move-left! a 3 5 b 8)))) | |
110 | ||
111 | (with-test-prefix "vector-move-right!" | |
112 | ||
113 | (pass-if-exception "before start" exception:out-of-range | |
114 | (let ((a (vector 1 2 3 4 5 6 7 8 9)) | |
115 | (b (vector 10 20 30 40 50 60 70 80 90))) | |
116 | (vector-move-right! a 3 5 b -1))) | |
117 | ||
118 | (pass-if "beginning" | |
119 | (let ((a (vector 1 2 3 4 5 6 7 8 9)) | |
120 | (b (vector 10 20 30 40 50 60 70 80 90))) | |
121 | (vector-move-right! a 3 5 b 0) | |
122 | (equal? b #(4 5 30 40 50 60 70 80 90)))) | |
123 | ||
124 | (pass-if "middle" | |
125 | (let ((a (vector 1 2 3 4 5 6 7 8 9)) | |
126 | (b (vector 10 20 30 40 50 60 70 80 90))) | |
127 | (vector-move-right! a 3 5 b 2) | |
128 | (equal? b #(10 20 4 5 50 60 70 80 90)))) | |
129 | ||
130 | (pass-if "overlap -" | |
131 | (let ((a (vector 1 2 3 4 5 6 7 8 9))) | |
132 | (vector-move-right! a 3 5 a 2) | |
133 | (equal? a #(1 2 5 5 5 6 7 8 9)))) | |
134 | ||
135 | (pass-if "overlap +" | |
136 | (let ((a (vector 1 2 3 4 5 6 7 8 9))) | |
137 | (vector-move-right! a 3 5 a 4) | |
138 | (equal? a #(1 2 3 4 4 5 7 8 9)))) | |
139 | ||
140 | (pass-if "end" | |
141 | (let ((a (vector 1 2 3 4 5 6 7 8 9)) | |
142 | (b (vector 10 20 30 40 50 60 70 80 90))) | |
143 | (vector-move-right! a 3 5 b 7) | |
144 | (equal? b #(10 20 30 40 50 60 70 4 5)))) | |
145 | ||
99015f6d AW |
146 | (pass-if "whole thing" |
147 | (let ((a (vector 1 2 3 4 5 6 7 8 9)) | |
148 | (b (vector 10 20 30 40 50 60 70 80 90))) | |
149 | (vector-move-right! a 0 9 b 0) | |
150 | (equal? b #(1 2 3 4 5 6 7 8 9)))) | |
151 | ||
551b96d2 AW |
152 | (pass-if-exception "past end" exception:out-of-range |
153 | (let ((a (vector 1 2 3 4 5 6 7 8 9)) | |
154 | (b (vector 10 20 30 40 50 60 70 80 90))) | |
155 | (vector-move-right! a 3 5 b 8)))) |