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