Commit | Line | Data |
---|---|---|
42b4fcb4 KR |
1 | ;;;; srfi-11.test --- exercise SRFI-11 let-values |
2 | ;;;; | |
6e7d5622 | 3 | ;;;; Copyright 2004, 2006 Free Software Foundation, Inc. |
42b4fcb4 KR |
4 | ;;;; |
5 | ;;;; This program is free software; you can redistribute it and/or modify | |
6 | ;;;; it under the terms of the GNU General Public License as published by | |
7 | ;;;; the Free Software Foundation; either version 2, or (at your option) | |
8 | ;;;; any later version. | |
9 | ;;;; | |
10 | ;;;; This program 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 | |
13 | ;;;; GNU General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU General Public License | |
16 | ;;;; along with this software; see the file COPYING. If not, write to | |
92205699 MV |
17 | ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
18 | ;;;; Boston, MA 02110-1301 USA | |
42b4fcb4 KR |
19 | |
20 | (define-module (test-suite test-srfi-11) | |
21 | #:use-module (test-suite lib) | |
22 | #:use-module (srfi srfi-11)) | |
23 | ||
24 | ||
25 | ;; | |
26 | ;; let-values | |
27 | ;; | |
28 | ||
29 | (with-test-prefix "let-values" | |
30 | ||
31 | (with-test-prefix "no exprs" | |
32 | ||
33 | (pass-if "no values" | |
34 | (let-values () | |
35 | #t))) | |
36 | ||
37 | (with-test-prefix "one expr" | |
38 | ||
39 | (pass-if "no values" | |
40 | (let-values ((() (values))) | |
41 | #t)) | |
42 | ||
43 | (pass-if "one value" | |
44 | (let-values (((x) (values 1))) | |
45 | (equal? x 1))) | |
46 | ||
47 | (pass-if "one value as rest" | |
48 | (let-values ((x (values 1))) | |
49 | (equal? x '(1)))) | |
50 | ||
51 | (pass-if "two values" | |
52 | (let-values (((x y) (values 1 2))) | |
53 | (and (equal? x 1) | |
54 | (equal? y 2))))) | |
55 | ||
56 | (with-test-prefix "two exprs" | |
57 | ||
58 | (pass-if "no values each" | |
59 | (let-values ((() (values)) | |
60 | (() (values))) | |
61 | #t)) | |
62 | ||
63 | (pass-if "one value / no values" | |
64 | (let-values (((x) (values 1)) | |
65 | (() (values))) | |
66 | (equal? x 1))) | |
67 | ||
68 | (pass-if "one value each" | |
69 | (let-values (((x) (values 1)) | |
70 | ((y) (values 2))) | |
71 | (and (equal? x 1) | |
72 | (equal? y 2)))) | |
73 | ||
74 | (pass-if-exception "first binding invisible to second expr" | |
75 | '(unbound-variable . ".*") | |
76 | (let-values (((x) (values 1)) | |
77 | ((y) (values (1+ x)))) | |
78 | #f)))) | |
79 | ||
80 | ;; | |
81 | ;; let*-values | |
82 | ;; | |
83 | ||
84 | (with-test-prefix "let*-values" | |
85 | ||
86 | (with-test-prefix "no exprs" | |
87 | ||
88 | (pass-if "no values" | |
89 | (let*-values () | |
90 | #t))) | |
91 | ||
92 | (with-test-prefix "one expr" | |
93 | ||
94 | (pass-if "no values" | |
95 | (let*-values ((() (values))) | |
96 | #t)) | |
97 | ||
98 | (pass-if "one value" | |
99 | (let*-values (((x) (values 1))) | |
100 | (equal? x 1))) | |
101 | ||
102 | (pass-if "one value as rest" | |
103 | (let-values ((x (values 1))) | |
104 | (equal? x '(1)))) | |
105 | ||
106 | (pass-if "two values" | |
107 | (let*-values (((x y) (values 1 2))) | |
108 | (and (equal? x 1) | |
109 | (equal? y 2))))) | |
110 | ||
111 | (with-test-prefix "two exprs" | |
112 | ||
113 | (pass-if "no values each" | |
114 | (let*-values ((() (values)) | |
115 | (() (values))) | |
116 | #t)) | |
117 | ||
118 | (pass-if "one value / no values" | |
119 | (let*-values (((x) (values 1)) | |
120 | (() (values))) | |
121 | (equal? x 1))) | |
122 | ||
123 | (pass-if "one value each" | |
124 | (let*-values (((x) (values 1)) | |
125 | ((y) (values 2))) | |
126 | (and (equal? x 1) | |
127 | (equal? y 2)))) | |
128 | ||
129 | (pass-if "first binding visible to second expr" | |
130 | (let*-values (((x) (values 1)) | |
131 | ((y) (values (1+ x)))) | |
132 | (and (equal? x 1) | |
133 | (equal? y 2)))))) |