← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/fdefinition.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/fdefinition.lsp
 
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
  (signals-error (fdefinition (gensym)) undefined-function)
 
20
  t)
 
21
 
 
22
(deftest fdefinition.error.4
 
23
  (signals-error (fdefinition 10) type-error)
 
24
  t)
 
25
 
 
26
(deftest fdefinition.error.5
 
27
  (signals-error (fdefinition (list 'setf (gensym))) undefined-function)
 
28
  t)
 
29
 
 
30
(deftest fdefinition.error.6
 
31
  (signals-error (locally (fdefinition 10) t) type-error)
 
32
  t)
 
33
 
 
34
;;; Non-error cases
 
35
 
 
36
(deftest fdefinition.1
 
37
  (let ((fun (fdefinition 'cons)))
 
38
    (funcall fun 'a 'b))
 
39
  (a . b))
 
40
 
 
41
(deftest fdefinition.2
 
42
  (progn
 
43
    (fdefinition 'cond)
 
44
    :good)
 
45
  :good)
 
46
 
 
47
(deftest fdefinition.3
 
48
  (progn
 
49
    (fdefinition 'setq)
 
50
    :good)
 
51
  :good)
 
52
 
 
53
(deftest fdefinition.4
 
54
  (let ((sym (gensym)))
 
55
    (values
 
56
     (fboundp sym)
 
57
     (progn
 
58
       (setf (fdefinition sym) (fdefinition 'cons))
 
59
       (funcall (symbol-function sym) 'a 'b))
 
60
     (notnot (fboundp sym))))
 
61
  nil
 
62
  (a . b)
 
63
  t)
 
64
 
 
65
(deftest fdefinition.5
 
66
  (let* ((sym (gensym))
 
67
         (fname (list 'setf sym)))
 
68
    (values
 
69
     (fboundp fname)
 
70
     (progn
 
71
       (setf (fdefinition fname) (fdefinition 'cons))
 
72
       (eval `(setf (,sym 'a) 'b)))
 
73
     (notnot (fboundp fname))))
 
74
  nil
 
75
  (b . a)
 
76
  t)
 
77
 
 
78
(deftest fdefinition.order.1
 
79
  (let ((i 0))
 
80
    (fdefinition (progn (incf i) 'setq))
 
81
    i)
 
82
  1)
 
83