1;;;; srfi-11.test --- exercise SRFI-11 let-values 2;;;; 3;;;; Copyright 2004, 2006 Free Software Foundation, Inc. 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 19(define-module (test-suite test-srfi-11) 20 #:use-module (test-suite lib) 21 #:use-module (srfi srfi-11)) 22 23 24;; 25;; let-values 26;; 27 28(with-test-prefix "let-values" 29 30 (with-test-prefix "no exprs" 31 32 (pass-if "no values" 33 (let-values () 34 #t))) 35 36 (with-test-prefix "one expr" 37 38 (pass-if "no values" 39 (let-values ((() (values))) 40 #t)) 41 42 (pass-if "one value" 43 (let-values (((x) (values 1))) 44 (equal? x 1))) 45 46 (pass-if "one value as rest" 47 (let-values ((x (values 1))) 48 (equal? x '(1)))) 49 50 (pass-if "two values" 51 (let-values (((x y) (values 1 2))) 52 (and (equal? x 1) 53 (equal? y 2))))) 54 55 (with-test-prefix "two exprs" 56 57 (pass-if "no values each" 58 (let-values ((() (values)) 59 (() (values))) 60 #t)) 61 62 (pass-if "one value / no values" 63 (let-values (((x) (values 1)) 64 (() (values))) 65 (equal? x 1))) 66 67 (pass-if "one value each" 68 (let-values (((x) (values 1)) 69 ((y) (values 2))) 70 (and (equal? x 1) 71 (equal? y 2)))) 72 73 (pass-if-exception "first binding invisible to second expr" 74 '(unbound-variable . ".*") 75 (let-values (((x) (values 1)) 76 ((y) (values (1+ x)))) 77 #f)) 78 79 (pass-if "first binding with rest invisible to second expr" 80 (let* ((a 1) 81 (b (let-values (((a . b) (values 2 3)) 82 (c (begin (set! a 9) 4))) 83 (list a b c)))) 84 (equal? (cons a b) '(9 2 (3) (4))))))) 85 86;; 87;; let*-values 88;; 89 90(with-test-prefix "let*-values" 91 92 (with-test-prefix "no exprs" 93 94 (pass-if "no values" 95 (let*-values () 96 #t))) 97 98 (with-test-prefix "one expr" 99 100 (pass-if "no values" 101 (let*-values ((() (values))) 102 #t)) 103 104 (pass-if "one value" 105 (let*-values (((x) (values 1))) 106 (equal? x 1))) 107 108 (pass-if "one value as rest" 109 (let-values ((x (values 1))) 110 (equal? x '(1)))) 111 112 (pass-if "two values" 113 (let*-values (((x y) (values 1 2))) 114 (and (equal? x 1) 115 (equal? y 2))))) 116 117 (with-test-prefix "two exprs" 118 119 (pass-if "no values each" 120 (let*-values ((() (values)) 121 (() (values))) 122 #t)) 123 124 (pass-if "one value / no values" 125 (let*-values (((x) (values 1)) 126 (() (values))) 127 (equal? x 1))) 128 129 (pass-if "one value each" 130 (let*-values (((x) (values 1)) 131 ((y) (values 2))) 132 (and (equal? x 1) 133 (equal? y 2)))) 134 135 (pass-if "first binding visible to second expr" 136 (let*-values (((x) (values 1)) 137 ((y) (values (1+ x)))) 138 (and (equal? x 1) 139 (equal? y 2)))))) 140