1;;;; srfi-111.test --- Test suite for SRFI-111 (Boxes). -*- scheme -*- 2;;;; 3;;;; Copyright (C) 2014 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-111) 20 #:use-module (test-suite lib) 21 #:use-module (srfi srfi-1) 22 #:use-module (srfi srfi-111)) 23 24(with-test-prefix "srfi-111" 25 26 (let ((test-vals '(#f #t #\space "string" -5 #e1e100 1e-30 #(a vector)))) 27 (pass-if-equal "box and unbox" 28 test-vals 29 (map (lambda (x) 30 (unbox (box x))) 31 test-vals)) 32 33 (pass-if "box?" 34 (and (box? (box 5)) 35 (not (any box? test-vals)))) 36 37 (pass-if-equal "set-box!" 38 "string" 39 (let ((b (box #f))) 40 (set-box! b "string") 41 (unbox b))) 42 43 (pass-if "eq? on boxes" 44 (let ((box1 (box #f)) 45 (box2 (box #f))) 46 (and (eq? box1 box1) 47 (eq? box2 box2) 48 (not (eq? box1 box2))))) 49 50 (pass-if "eqv? on boxes" 51 (let ((box1 (box #f)) 52 (box2 (box #f))) 53 (and (eqv? box1 box1) 54 (eqv? box2 box2) 55 (not (eqv? box1 box2))))) 56 57 (pass-if "equal? on boxes" 58 (let ((box1 (box "foo")) 59 (box2 (box "bar"))) 60 (and (equal? box1 box1) 61 (equal? box2 box2) 62 (not (equal? box1 box2)) 63 ;; Guile extension, not guaranteed by SRFI-111. 64 (begin (set-box! box2 (string #\f #\o #\o)) 65 (equal? box1 box2))))))) 66