test-suite/tests/srfi-11.test

   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 ;;
  80 ;; let*-values
  81 ;;
  82
  83 (with-test-prefix "let*-values"
  84
  85   (with-test-prefix "no exprs"
  86
  87     (pass-if "no values"
  88       (let*-values ()
  89         #t)))
  90
  91   (with-test-prefix "one expr"
  92
  93     (pass-if "no values"
  94       (let*-values ((() (values)))
  95         #t))
  96
  97     (pass-if "one value"
  98       (let*-values (((x) (values 1)))
  99         (equal? x 1)))
 100
 101     (pass-if "one value as rest"
 102       (let-values ((x (values 1)))
 103         (equal? x '(1))))
 104
 105     (pass-if "two values"
 106       (let*-values (((x y) (values 1 2)))
 107         (and (equal? x 1)
 108              (equal? y 2)))))
 109
 110   (with-test-prefix "two exprs"
 111
 112     (pass-if "no values each"
 113       (let*-values ((() (values))
 114                     (() (values)))
 115         #t))
 116
 117     (pass-if "one value / no values"
 118       (let*-values (((x) (values 1))
 119                     (() (values)))
 120         (equal? x 1)))
 121
 122     (pass-if "one value each"
 123       (let*-values (((x) (values 1))
 124                     ((y) (values 2)))
 125         (and (equal? x 1)
 126              (equal? y 2))))
 127
 128     (pass-if "first binding visible to second expr"
 129       (let*-values (((x) (values 1))
 130                     ((y) (values (1+ x))))
 131         (and (equal? x 1)
 132              (equal? y 2))))))