guile18/test-suite/tests/q.test

   1 ;;;; q.test --- test (ice-9 q) module -*- scheme -*-
   2 ;;;;
   3 ;;;; Copyright 2004, 2006 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 2.1 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-suite test-ice-9-q)
  20   #:use-module (test-suite lib)
  21   #:use-module (ice-9 q))
  22
  23
  24 ;; Call (THUNK) and return #t if it throws 'q-empty, or #f it not.
  25 (define (true-if-catch-q-empty thunk)
  26   (catch 'q-empty
  27     (lambda ()
  28       (thunk)
  29       #f)
  30     (lambda args
  31       #t)))
  32
  33
  34 ;;;
  35 ;;; q-pop!
  36 ;;;
  37
  38 (with-test-prefix "q-pop!"
  39
  40   (with-test-prefix "no elems"
  41     (let ((q (make-q)))
  42       (pass-if "empty" (true-if-catch-q-empty
  43                         (lambda ()
  44                           (q-pop! q))))
  45       (pass-if "valid at end" (q? q))))
  46
  47   (with-test-prefix "one elem"
  48     (let ((x (cons 1 2))
  49           (q (make-q)))
  50       (q-push! q x)
  51
  52       (pass-if "x" (eq? x (q-pop! q)))
  53       (pass-if "valid after x" (q? q))
  54       (pass-if "empty" (true-if-catch-q-empty
  55                         (lambda ()
  56                           (q-pop! q))))
  57       (pass-if "valid at end" (q? q))))
  58
  59   (with-test-prefix "two elems"
  60     (let ((x (cons 1 2))
  61           (y (cons 3 4))
  62           (q (make-q)))
  63       (q-push! q x)
  64       (q-push! q y)
  65
  66       (pass-if "y" (eq? y (q-pop! q)))
  67       (pass-if "valid after y" (q? q))
  68       (pass-if "x" (eq? x (q-pop! q)))
  69       (pass-if "valid after x" (q? q))
  70       (pass-if "empty" (true-if-catch-q-empty
  71                         (lambda ()
  72                           (q-pop! q))))
  73       (pass-if "valid at end" (q? q))))
  74
  75   (with-test-prefix "three elems"
  76     (let ((x (cons 1 2))
  77           (y (cons 3 4))
  78           (z (cons 5 6))
  79           (q (make-q)))
  80       (q-push! q x)
  81       (q-push! q y)
  82       (q-push! q z)
  83
  84       (pass-if "z" (eq? z (q-pop! q)))
  85       (pass-if "valid after z" (q? q))
  86       (pass-if "y" (eq? y (q-pop! q)))
  87       (pass-if "valid after y" (q? q))
  88       (pass-if "x" (eq? x (q-pop! q)))
  89       (pass-if "valid after x" (q? q))
  90       (pass-if "empty" (true-if-catch-q-empty
  91                         (lambda ()
  92                           (q-pop! q))))
  93       (pass-if "valid at end" (q? q)))))