Commit | Line | Data |
---|---|---|
42a71068 | 1 | ;;;; rnrs-libraries.test --- test library and import forms -*- scheme -*- |
d10f7b57 | 2 | ;;;; Copyright (C) 2010, 2012 Free Software Foundation, Inc. |
42a71068 AW |
3 | ;;;; |
4 | ;;;; This library is free software; you can redistribute it and/or | |
5 | ;;;; modify it under the terms of the GNU Lesser General Public | |
6 | ;;;; License as published by the Free Software Foundation; either | |
7 | ;;;; version 3 of the License, or (at your option) any later version. | |
8 | ;;;; | |
9 | ;;;; This library is distributed in the hope that it will be useful, | |
10 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
12 | ;;;; Lesser General Public License for more details. | |
13 | ;;;; | |
14 | ;;;; You should have received a copy of the GNU Lesser General Public | |
15 | ;;;; License along with this library; if not, write to the Free Software | |
16 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
17 | ||
d10f7b57 | 18 | (define-module (tests rnrs-libraries) |
42a71068 AW |
19 | #:use-module (test-suite lib)) |
20 | ||
21 | ;; First, check that Guile modules are r6rs modules. | |
22 | ;; | |
23 | (with-test-prefix "ice-9 receive" | |
24 | (define iface #f) | |
25 | ||
26 | (pass-if "import" | |
27 | (eval '(begin | |
28 | (import (ice-9 receive)) | |
29 | #t) | |
30 | (current-module))) | |
31 | ||
32 | (pass-if "resolve-interface" | |
33 | (module? (resolve-interface '(ice-9 receive)))) | |
34 | ||
35 | (set! iface (resolve-interface '(ice-9 receive))) | |
36 | ||
37 | (pass-if "resolve-r6rs-interface" | |
38 | (eq? iface (resolve-r6rs-interface '(ice-9 receive)))) | |
39 | ||
40 | (pass-if "resolve-r6rs-interface (2)" | |
41 | (eq? iface (resolve-r6rs-interface '(library (ice-9 receive))))) | |
42 | ||
43 | (pass-if "module uses" | |
44 | (and (memq iface (module-uses (current-module))) #t)) | |
45 | ||
46 | (pass-if "interface contents" | |
47 | (equal? '(receive) | |
48 | (hash-map->list (lambda (sym var) sym) (module-obarray iface)))) | |
49 | ||
50 | (pass-if "interface uses" | |
51 | (null? (module-uses iface))) | |
52 | ||
53 | (pass-if "version" | |
54 | (or (not (module-version iface)) | |
55 | (null? (module-version iface)))) | |
56 | ||
57 | (pass-if "calling receive from current env" | |
58 | (equal? (eval '(receive (a b) (values 10 32) | |
59 | (+ a b)) | |
60 | (current-module)) | |
61 | 42))) | |
62 | ||
63 | ||
64 | ;; And check that r6rs modules are guile modules. | |
65 | ;; | |
66 | (with-test-prefix "rnrs-test-a" | |
67 | (define iface #f) | |
68 | ||
69 | (pass-if "no double" | |
70 | (not (module-local-variable (current-module) 'double))) | |
71 | ||
72 | (pass-if "import" | |
73 | (eval '(begin | |
d10f7b57 | 74 | (import (tests rnrs-test-a)) |
42a71068 AW |
75 | #t) |
76 | (current-module))) | |
77 | ||
78 | (pass-if "still no double" | |
79 | (not (module-local-variable (current-module) 'double))) | |
80 | ||
81 | (pass-if "resolve-interface" | |
d10f7b57 | 82 | (module? (resolve-interface '(tests rnrs-test-a)))) |
42a71068 | 83 | |
d10f7b57 | 84 | (set! iface (resolve-interface '(tests rnrs-test-a))) |
42a71068 AW |
85 | |
86 | (pass-if "resolve-interface (2)" | |
d10f7b57 | 87 | (eq? iface (resolve-interface '(tests rnrs-test-a)))) |
42a71068 AW |
88 | |
89 | (pass-if "resolve-r6rs-interface" | |
d10f7b57 | 90 | (eq? iface (resolve-r6rs-interface '(tests rnrs-test-a)))) |
42a71068 AW |
91 | |
92 | (pass-if "resolve-r6rs-interface (2)" | |
d10f7b57 | 93 | (eq? iface (resolve-r6rs-interface '(library (tests rnrs-test-a))))) |
42a71068 AW |
94 | |
95 | (pass-if "module uses" | |
96 | (and (memq iface (module-uses (current-module))) #t)) | |
97 | ||
98 | (pass-if "interface contents" | |
99 | (equal? '(double) | |
100 | (hash-map->list (lambda (sym var) sym) (module-obarray iface)))) | |
101 | ||
102 | (pass-if "interface uses" | |
103 | (null? (module-uses iface))) | |
104 | ||
105 | (pass-if "version" | |
106 | (or (not (module-version iface)) | |
107 | (null? (module-version iface)))) | |
108 | ||
109 | (pass-if "calling double" | |
110 | (equal? ((module-ref iface 'double) 10) | |
111 | 20)) | |
112 | ||
113 | (pass-if "calling double from current env" | |
114 | (equal? (eval '(double 20) (current-module)) | |
115 | 40))) | |
116 | ||
04186f20 JG |
117 | ;; Guile should ignore explicit phase specifications |
118 | ;; | |
119 | (with-test-prefix "implicit phasing" | |
120 | (with-test-prefix "in library form" | |
121 | (pass-if "explicit phasing ignored" | |
122 | (import (for (guile) (meta -1))) #t)) | |
123 | ||
124 | (with-test-prefix "in library form" | |
125 | (pass-if "explicit phasing ignored" | |
126 | (save-module-excursion | |
127 | (lambda () | |
128 | (library (test) | |
129 | (export) | |
130 | (import (for (guile) (meta -1)))) | |
131 | #t))))) | |
42a71068 AW |
132 | |
133 | ;; Now import features. | |
134 | ;; | |
135 | (with-test-prefix "import features" | |
136 | (define iface #f) | |
137 | ||
138 | (with-test-prefix "only" | |
139 | (pass-if "contents" | |
140 | (equal? '(+) | |
141 | (hash-map->list | |
142 | (lambda (sym var) sym) | |
143 | (module-obarray (resolve-r6rs-interface '(only (guile) +))))))) | |
144 | ||
145 | (with-test-prefix "except" | |
146 | (let ((bindings (hash-map->list | |
147 | (lambda (sym var) sym) | |
148 | (module-obarray | |
149 | (resolve-r6rs-interface '(except (guile) +)))))) | |
150 | (pass-if "contains" | |
151 | (equal? (length bindings) | |
152 | (1- (hash-fold | |
153 | (lambda (sym var n) (1+ n)) | |
154 | 0 | |
155 | (module-obarray (resolve-interface '(guile))))))) | |
156 | (pass-if "does not contain" | |
157 | (not (memq '+ bindings))))) | |
158 | ||
159 | (with-test-prefix "prefix" | |
160 | (let ((iface (resolve-r6rs-interface '(prefix (ice-9 q) q:)))) | |
161 | (pass-if "contains" | |
162 | ((module-ref iface 'q:q?) ((module-ref iface 'q:make-q)))) | |
163 | (pass-if "does not contain" | |
164 | (not (module-local-variable iface 'make-q))))) | |
165 | ||
166 | (with-test-prefix "rename" | |
167 | (let ((iface (resolve-r6rs-interface | |
168 | '(rename (only (guile) cons car cdr) | |
169 | (cons snoc) | |
170 | (car rac) | |
171 | (cdr rdc))))) | |
172 | (pass-if "contents" | |
173 | (equal? '("rac" "rdc" "snoc") | |
174 | (sort | |
175 | (hash-map->list | |
176 | (lambda (sym var) (symbol->string sym)) | |
177 | (module-obarray iface)) | |
178 | string<))) | |
179 | (pass-if "contains" | |
180 | (equal? 3 ((module-ref iface 'rac) | |
181 | ((module-ref iface 'snoc) 3 4)))))) | |
182 | ||
183 | (with-test-prefix "srfi" | |
184 | (pass-if "renaming works" | |
185 | (eq? (resolve-interface '(srfi srfi-1)) | |
5d7c55bd IP |
186 | (resolve-r6rs-interface '(srfi :1))) |
187 | (eq? (resolve-interface '(srfi srfi-1)) | |
188 | (resolve-r6rs-interface '(srfi :1 lists))))) | |
ffd48603 AW |
189 | |
190 | (with-test-prefix "macro" | |
191 | (pass-if "multiple clauses" | |
192 | (eval '(begin | |
193 | (import (rnrs) (for (rnrs) expand) (rnrs)) | |
194 | #t) | |
195 | (current-module))))) |