test-suite/tests/srfi-111.test

   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)))))))