Implement R6RS bytevector read syntax.

[bpt/guile.git] / test-suite / lib.scm

diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index c4ddf9e..8190d1f 100644 (file)
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -1,20 +1,20 @@
 ;;;; test-suite/lib.scm --- generic support for testing
-;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007, 2009 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This program 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 3, or (at your option) any later version.
 ;;;;
 ;;;; This program 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 General Public License for more details.
+;;;; GNU Lesser General Public License for more details.
 ;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this software; see the file COPYING.LESSER.
+;;;; If not, write to the Free Software Foundation, Inc., 51 Franklin
+;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite lib)
   :use-module (ice-9 stack-catch)
@@ -32,6 +32,7 @@
  exception:system-error
  exception:miscellaneous-error
  exception:string-contains-nul
+ exception:read-error
 
  ;; Reporting passes and failures.
  run-test
@@ -265,6 +266,8 @@
   (cons 'system-error ".*"))
 (define exception:miscellaneous-error
   (cons 'misc-error "^.*"))
+(define exception:read-error
+  (cons 'read-error "^.*$"))
 
 ;; as per throw in scm_to_locale_stringn()
 (define exception:string-contains-nul
@@ -317,20 +320,24 @@
   (set! run-test local-run-test))
 
 ;;; A short form for tests that are expected to pass, taken from Greg.
-(defmacro pass-if (name . rest)
-  (if (and (null? rest) (pair? name))
-      ;; presume this is a simple test, i.e. (pass-if (even? 2))
-      ;; where the body should also be the name.
-      `(run-test ',name #t (lambda () ,name))
-      `(run-test ,name #t (lambda () ,@rest))))
+(define-syntax pass-if
+  (syntax-rules ()
+    ((_ name)
+     ;; presume this is a simple test, i.e. (pass-if (even? 2))
+     ;; where the body should also be the name.
+     (run-test 'name #t (lambda () name)))
+    ((_ name rest ...)
+     (run-test name #t (lambda () rest ...)))))
 
 ;;; A short form for tests that are expected to fail, taken from Greg.
-(defmacro expect-fail (name . rest)
-  (if (and (null? rest) (pair? name))
-      ;; presume this is a simple test, i.e. (expect-fail (even? 2))
-      ;; where the body should also be the name.
-      `(run-test ',name #f (lambda () ,name))
-      `(run-test ,name #f (lambda () ,@rest))))
+(define-syntax expect-fail
+  (syntax-rules ()
+    ((_ name)
+     ;; presume this is a simple test, i.e. (expect-fail (even? 2))
+     ;; where the body should also be the name.
+     (run-test 'name #f (lambda () name)))
+    ((_ name rest ...)
+     (run-test name #f (lambda () rest ...)))))
 
 ;;; A helper function to implement the macros that test for exceptions.
 (define (run-test-exception name exception expect-pass thunk)
@@ -362,12 +369,16 @@
             (apply throw key proc message rest))))))))
 
 ;;; A short form for tests that expect a certain exception to be thrown.
-(defmacro pass-if-exception (name exception body . rest)
-  `(,run-test-exception ,name ,exception #t (lambda () ,body ,@rest)))
+(define-syntax pass-if-exception
+  (syntax-rules ()
+    ((_ name exception body rest ...)
+     (run-test-exception name exception #t (lambda () body rest ...)))))
 
 ;;; A short form for tests expected to fail to throw a certain exception.
-(defmacro expect-fail-exception (name exception body . rest)
-  `(,run-test-exception ,name ,exception #f (lambda () ,body ,@rest)))
+(define-syntax expect-fail-exception
+  (syntax-rules ()
+    ((_ name exception body rest ...)
+     (run-test-exception name exception #f (lambda () body rest ...)))))
 
 \f
 ;;;; TEST NAMES