1;;;; future.test --- Futures.       -*- mode: scheme; coding: utf-8; -*-
2;;;;
3;;;; Ludovic Courtès <ludo@gnu.org>
4;;;;
5;;;; 	Copyright (C) 2010, 2012, 2013 Free Software Foundation, Inc.
6;;;;
7;;;; This library is free software; you can redistribute it and/or
8;;;; modify it under the terms of the GNU Lesser General Public
9;;;; License as published by the Free Software Foundation; either
10;;;; version 3 of the License, or (at your option) any later version.
11;;;;
12;;;; This library is distributed in the hope that it will be useful,
13;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15;;;; Lesser General Public License for more details.
16;;;;
17;;;; You should have received a copy of the GNU Lesser General Public
18;;;; License along with this library; if not, write to the Free Software
19;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20
21(define-module (test-future)
22  #:use-module (test-suite lib)
23  #:use-module (ice-9 futures)
24  #:use-module (srfi srfi-1)
25  #:use-module (srfi srfi-26))
26
27(define specific-exception-key (gensym))
28
29(define specific-exception
30  (cons specific-exception-key ".*"))
31
32
33(with-test-prefix "futures"
34
35  (pass-if "make-future"
36    (future? (make-future (lambda () #f))))
37
38  (pass-if "future"
39    (future? (future #t)))
40
41  (pass-if "true"
42    (touch (future #t)))
43
44  (pass-if "(+ 2 3)"
45    (= 5 (touch (future (+ 2 3)))))
46
47  (pass-if "many"
48    (equal? (iota 1234)
49            (map touch
50                 (map (lambda (i)
51                        (make-future (lambda () i)))
52                      (iota 1234)))))
53
54  (pass-if "touch several times"
55    (let* ((f+    (unfold (cut >= <> 123)
56                          (lambda (i)
57                            (make-future
58                             (let ((x (1- i)))
59                               (lambda ()
60                                 (set! x (1+ x))
61                                 i))))
62                          1+
63                          0))
64           (r1    (map touch f+))
65           (r2    (map touch f+))
66           (r3    (map touch f+)))
67      (equal? (iota 123) r1 r2 r3)))
68
69  (pass-if "nested"
70    (= (touch (future (+ 2 (touch (future -2))
71                         (reduce + 0
72                                 (map touch
73                                      (map (lambda (i)
74                                             (future i))
75                                           (iota 123)))))))
76       (reduce + 0 (iota 123))))
77
78  (pass-if "multiple values"
79    (let ((lst (iota 123)))
80      (equal? (zip lst lst)
81              (map (lambda (f)
82                     (call-with-values (cut touch f) list))
83                   (map (lambda (i)
84                          (future (values i i)))
85                        lst)))))
86
87  (pass-if "no exception"
88    (future? (future (throw 'foo 'bar))))
89
90  (pass-if-exception "exception"
91    specific-exception
92    (touch (future (throw specific-exception-key 'test "thrown!")))))
93
94(with-test-prefix "nested futures"
95
96  (pass-if-equal "simple" 2
97    (touch (future (1+ (touch (future (1+ (touch (future 0)))))))))
98
99  (pass-if-equal "loop" (map - (iota 1000))
100    (let loop ((list (iota 1000)))
101      (if (null? list)
102          '()
103          (cons (- (car list))
104                (touch (future (loop (cdr list)))))))))
105