source: trunk/source/tests/ansi-tests/fdefinition.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: 2.1 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Mon Jan 13 15:27:51 2003
4;;;; Contains: Tests for FDEFINITION
5
6(in-package :cl-test)
7
8;;; Error cases
9
10(deftest fdefinition.error.1
11  (signals-error (fdefinition) program-error)
12  t)
13
14(deftest fdefinition.error.2
15  (signals-error (fdefinition 'cons nil) program-error)
16  t)
17
18(deftest fdefinition.error.3
19  (let ((v (gensym)))
20    (eval `(signals-error (fdefinition ',v) undefined-function
21                          :name ,v)))
22  t)
23
24(deftest fdefinition.error.4
25  (check-type-error #'fdefinition #'(lambda (x) (typep x '(or symbol (cons (eql setf) (cons symbol null))))))
26  nil)
27
28;;; (deftest fdefinition.error.5
29;;;  (let ((fn `(setf ,(gensym))))
30;;;    (eval `(signals-error (fdefinition ',fn) undefined-function
31;;;                       :name ,fn)))
32;;;  t)
33
34(deftest fdefinition.error.6
35  (signals-error (locally (fdefinition 10) t) type-error)
36  t)
37
38(deftest fdefinition.error.7
39  (check-type-error #'fdefinition (constantly nil) '((setf) (setf . foo) (setf foo . bar) (setf foo bar)))
40  nil)
41
42(deftest fdefinition.error.8
43  (loop for x in *mini-universe*
44        unless (symbolp x)
45        nconc
46        (handler-case
47         (list x (fdefinition `(setf ,x)))
48         (type-error (c)
49                     (assert (not (typep (type-error-datum c)
50                                         (type-error-expected-type c))))
51                     nil)
52         (error (c) (list (list x c)))))
53  nil)
54
55;;; Non-error cases
56
57(deftest fdefinition.1
58  (let ((fun (fdefinition 'cons)))
59    (funcall fun 'a 'b))
60  (a . b))
61
62(deftest fdefinition.2
63  (progn
64    (fdefinition 'cond)
65    :good)
66  :good)
67
68(deftest fdefinition.3
69  (progn
70    (fdefinition 'setq)
71    :good)
72  :good)
73
74(deftest fdefinition.4
75  (let ((sym (gensym)))
76    (values
77     (fboundp sym)
78     (progn
79       (setf (fdefinition sym) (fdefinition 'cons))
80       (funcall (symbol-function sym) 'a 'b))
81     (notnot (fboundp sym))))
82  nil
83  (a . b)
84  t)
85
86(deftest fdefinition.5
87  (let* ((sym (gensym))
88         (fname (list 'setf sym)))
89    (values
90     (fboundp fname)
91     (progn
92       (setf (fdefinition fname) (fdefinition 'cons))
93       (eval `(setf (,sym 'a) 'b)))
94     (notnot (fboundp fname))))
95  nil
96  (b . a)
97  t)
98
99(deftest fdefinition.order.1
100  (let ((i 0))
101    (fdefinition (progn (incf i) 'setq))
102    i)
103  1)
104
Note: See TracBrowser for help on using the repository browser.