1;;;; srfi-2.test --- Test suite for Guile's and-let* macro. -*- scheme -*-
2;;;;
3;;;; Copyright (C) 2015 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-srfi-2)
20  #:use-module (test-suite lib)
21  #:use-module (srfi srfi-2))
22
23(pass-if-equal 1 (and-let* () 1))
24(pass-if-equal 2 (and-let* () 1 2))
25(pass-if-equal #t (and-let* ()))
26
27(pass-if-equal #f (let ((x #f)) (and-let* (x))))
28(pass-if-equal 1 (let ((x 1)) (and-let* (x))))
29(pass-if-equal #f (and-let* ((x #f))))
30(pass-if-equal 1 (and-let* ((x 1))))
31(pass-if-exception "bad clause" '(syntax-error . "Bad clause")
32  (eval '(and-let* (#f (x 1))) (current-module)))
33(pass-if-equal #f (and-let* ((#f) (x 1))))
34(pass-if-exception "bad clause" '(syntax-error . "Bad clause")
35  (eval '(and-let* (2 (x 1))) (current-module)))
36(pass-if-equal 1 (and-let* ((2) (x 1))))
37(pass-if-equal 2 (and-let* ((x 1) (2))))
38(pass-if-equal #f (let ((x #f)) (and-let* (x) x)))
39(pass-if-equal "" (let ((x "")) (and-let* (x) x)))
40(pass-if-equal "" (let ((x "")) (and-let* (x))))
41(pass-if-equal 2 (let ((x 1)) (and-let* (x) (+ x 1))))
42(pass-if-equal #f (let ((x #f)) (and-let* (x) (+ x 1))))
43(pass-if-equal 2 (let ((x 1)) (and-let* (((positive? x))) (+ x 1))))
44(pass-if-equal #t (let ((x 1)) (and-let* (((positive? x))))))
45(pass-if-equal #f (let ((x 0)) (and-let* (((positive? x))) (+ x 1))))
46(pass-if-equal 3
47    (let ((x 1)) (and-let* (((positive? x)) (x (+ x 1))) (+ x 1))))
48
49;; This is marked as must-be-error in the original test suite, but
50;; that's a mistake of the SRFI author who thinks that rebinding
51;; variables in let* is an error; in fact it's allowed in let*
52;; (explicitly since R6RS), so it should be allowed by and-let* too.
53(pass-if-equal 4
54    (let ((x 1))
55      (and-let* (((positive? x)) (x (+ x 1)) (x (+ x 1))) (+ x 1))))
56
57(pass-if-equal 2
58    (let ((x 1)) (and-let* (x ((positive? x))) (+ x 1))))
59(pass-if-equal 2
60    (let ((x 1)) (and-let* (((begin x)) ((positive? x))) (+ x 1))))
61(pass-if-equal #f
62    (let ((x 0)) (and-let* (x ((positive? x))) (+ x 1))))
63(pass-if-equal #f
64    (let ((x #f)) (and-let* (x ((positive? x))) (+ x 1))))
65(pass-if-equal #f
66    (let ((x #f)) (and-let* (((begin x)) ((positive? x))) (+ x 1))))
67
68(pass-if-equal #f
69    (let ((x 1)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
70(pass-if-equal #f
71    (let ((x 0)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
72(pass-if-equal #f
73    (let ((x #f)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
74(pass-if-equal 3/2
75    (let ((x 3)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
76
77;;; srfi-2.test ends here
78