1;;;; srfi-11.test --- exercise SRFI-11 let-values
2;;;;
3;;;; Copyright 2004, 2006 Free Software Foundation, Inc.
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
17;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
18;;;; Boston, MA 02110-1301 USA
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))))))
134