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