source: trunk/source/tests/ansi-tests/beyond-ansi/ba-aux.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 1.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Mon May 30 06:45:08 2005
4;;;; Contains: Aux. files for beyond-ansi tests
5
6(in-package :ba-test)
7
8(defun function-name-p (x)
9  (or (symbolp x)
10      (and (consp x)
11           (eql (car x) 'setf)
12           (consp (cdr x))
13           (symbolp (cadr x))
14           (null (cddr x)))))
15
16(defun symbol-or-function-p (x)
17  (or (symbolp x)
18      (and (consp x)
19           (eql (car x) 'function)
20           (consp (cdr x))
21           (null (cddr x))
22           (function-name-p (cadr x)))))
23
24(defun symbol-or-list-p (x)
25  (or (symbolp x) (listp x)))
26
27(defun function-designator-p (x)
28  (or (functionp x)
29      (and (symbolp x) (not (macro-function x)) (not (special-operator-p x)))))
30
31(defun type-specifier-p (x)
32  (typep x '(or symbol list class)))
33
34(defun causes-error-p (pred formf &key (vals *mini-universe*) (var 'x))
35  (when (symbolp pred)
36    (assert (fboundp pred))
37    (setf pred (symbol-function pred)))
38  (loop for x in vals
39        for inner-form = (if (functionp formf)
40                             (funcall formf x)
41                           (subst `',x var formf))
42        for form = `(signals-error ,inner-form error)
43        unless (or (funcall pred x) (eval form))
44        collect x))
45
46(defmacro def-all-error-test (name pred form &rest other-args)
47  `(deftest ,name
48     (causes-error-p ,pred ,form ,@other-args)
49     nil))
50
51(defmacro def-error-test (name form)
52  `(deftest ,name
53     (signals-error ,form error)
54     t))
55
56
Note: See TracBrowser for help on using the repository browser.