reader-aux.lsp 1.53 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Jan 14 07:43:48 2005
;;;; Contains: Auxiliary functions and macros for reader tests

(in-package :cl-test)

;;; Define a test using standard io syntax

(defmacro def-syntax-test (name form &body expected-results)
  `(deftest ,name
     (with-standard-io-syntax (let ((*package* (find-package :cl-test))) ,form))
     ,@expected-results))

;;; Macros for testing specific features

(defmacro def-syntax-vector-test (name form &body expected-elements)
  `(def-syntax-test ,name
     (let ((v (read-from-string ,form)))
       (assert (simple-vector-p v))
       v)
     ,(apply #'vector expected-elements)))

(defmacro def-syntax-bit-vector-test (name form &body expected-elements)
  `(def-syntax-test ,name
     (let ((v (read-from-string ,form)))
       (assert (simple-bit-vector-p v))
       v)
     ,(make-array (length expected-elements) :element-type 'bit :initial-contents expected-elements)))

(defmacro def-syntax-unintern-test (name string)
  `(deftest ,name
     (let ((s (read-from-string ,(concatenate 'string "#:" string))))
       (values
sds's avatar
sds committed
35 36
        (symbol-package s)
        (symbol-name s)))
37 38 39 40 41 42 43 44
     nil ,(string-upcase string)))

(defmacro def-syntax-array-test (name form expected-result)
  `(def-syntax-test ,name
     (let ((v (read-from-string ,form)))
       (assert (typep v 'simple-array))
       (assert (not (array-has-fill-pointer-p v)))
       (assert (eql (array-element-type v)
sds's avatar
sds committed
45
                    (upgraded-array-element-type t)))
46 47 48 49
       v)
     ,(eval expected-result)))