summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKevin Ryde <user42@zip.com.au>2004-01-06 21:43:55 +0000
committerKevin Ryde <user42@zip.com.au>2004-01-06 21:43:55 +0000
commit8f85f93d88c24647dce830ea96b9293ae1256e06 (patch)
tree4e3fe452762758e8112897c083ce8b3882a360e6
parentb41478a13d5e51a53d834809d9b32e5acaf0b891 (diff)
downloadguile-8f85f93d88c24647dce830ea96b9293ae1256e06.tar.gz
New file.
(q-pop!): Exercise this, in particular the "not/null?" bug reported by Richard Todd.
-rw-r--r--test-suite/tests/q.test93
1 files changed, 93 insertions, 0 deletions
diff --git a/test-suite/tests/q.test b/test-suite/tests/q.test
new file mode 100644
index 000000000..a4960619c
--- /dev/null
+++ b/test-suite/tests/q.test
@@ -0,0 +1,93 @@
+;;;; q.test --- test (ice-9 q) module -*- scheme -*-
+;;;;
+;;;; Copyright 2004 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+(define-module (test-suite test-ice-9-q)
+ #:use-module (test-suite lib)
+ #:use-module (ice-9 q))
+
+
+;; Call (THUNK) and return #t if it throws 'q-empty, or #f it not.
+(define (true-if-catch-q-empty thunk)
+ (catch 'q-empty
+ (lambda ()
+ (thunk)
+ #f)
+ (lambda args
+ #t)))
+
+
+;;;
+;;; q-pop!
+;;;
+
+(with-test-prefix "q-pop!"
+
+ (with-test-prefix "no elems"
+ (let ((q (make-q)))
+ (pass-if "empty" (true-if-catch-q-empty
+ (lambda ()
+ (q-pop! q))))
+ (pass-if "valid at end" (q? q))))
+
+ (with-test-prefix "one elem"
+ (let ((x (cons 1 2))
+ (q (make-q)))
+ (q-push! q x)
+
+ (pass-if "x" (eq? x (q-pop! q)))
+ (pass-if "valid after x" (q? q))
+ (pass-if "empty" (true-if-catch-q-empty
+ (lambda ()
+ (q-pop! q))))
+ (pass-if "valid at end" (q? q))))
+
+ (with-test-prefix "two elems"
+ (let ((x (cons 1 2))
+ (y (cons 3 4))
+ (q (make-q)))
+ (q-push! q x)
+ (q-push! q y)
+
+ (pass-if "y" (eq? y (q-pop! q)))
+ (pass-if "valid after y" (q? q))
+ (pass-if "x" (eq? x (q-pop! q)))
+ (pass-if "valid after x" (q? q))
+ (pass-if "empty" (true-if-catch-q-empty
+ (lambda ()
+ (q-pop! q))))
+ (pass-if "valid at end" (q? q))))
+
+ (with-test-prefix "three elems"
+ (let ((x (cons 1 2))
+ (y (cons 3 4))
+ (z (cons 5 6))
+ (q (make-q)))
+ (q-push! q x)
+ (q-push! q y)
+ (q-push! q z)
+
+ (pass-if "z" (eq? z (q-pop! q)))
+ (pass-if "valid after z" (q? q))
+ (pass-if "y" (eq? y (q-pop! q)))
+ (pass-if "valid after y" (q? q))
+ (pass-if "x" (eq? x (q-pop! q)))
+ (pass-if "valid after x" (q? q))
+ (pass-if "empty" (true-if-catch-q-empty
+ (lambda ()
+ (q-pop! q))))
+ (pass-if "valid at end" (q? q)))))