← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/function.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/function.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Mon Oct  7 07:34:29 2002
 
4
;;;; Contains: Tests for type FUNCTION and the special form FUNCTION
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
;;;
 
9
;;; Note! There are significant incompatibilities between CLTL1 and ANSI CL
 
10
;;; in the meaning of FUNCTION and FUNCTIONP.
 
11
;;;
 
12
 
 
13
(deftest function.1
 
14
  (typep nil 'function)
 
15
  nil)
 
16
 
 
17
;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL.
 
18
;;; In ANSI CL, symbols are no longer of type FUNCTION.
 
19
(deftest function.2
 
20
  (typep 'identity 'function)
 
21
  nil)
 
22
 
 
23
(deftest function.3
 
24
  (not-mv (typep #'identity 'function))
 
25
  nil)
 
26
 
 
27
(deftest function.4
 
28
  (loop for x in *cl-symbol-names*
 
29
        for s = (find-symbol x "CL")
 
30
        for f = (and (fboundp s)
 
31
                     (symbol-function s)
 
32
                     (not (special-operator-p s))
 
33
                     (not (macro-function s))
 
34
                     (symbol-function s))
 
35
        unless (or (null f)
 
36
                   (typep f 'function))
 
37
        collect x)
 
38
  nil)
 
39
 
 
40
(deftest function.5
 
41
  (typep '(setf car) 'function)
 
42
  nil)
 
43
 
 
44
;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL.
 
45
;;; In ANSI CL, lambda forms are no longer of type FUNCTION.
 
46
(deftest function.6
 
47
  (typep '(lambda (x) x) 'function)
 
48
  nil)
 
49
 
 
50
(report-and-ignore-errors
 
51
 (defun (setf function-7-accessor) (y x) (setf (car x) y) y))
 
52
 
 
53
(deftest function.7
 
54
  (not-mv (typep #'(setf function-7-accessor) 'function))
 
55
  nil)
 
56
 
 
57
(deftest function.8
 
58
  (not-mv (typep #'(lambda (x) x) 'function))
 
59
  nil)
 
60
 
 
61
(deftest function.9
 
62
  (not-mv (typep (compile nil '(lambda (x) x)) 'function))
 
63
  nil)
 
64
 
 
65
;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL.
 
66
;;; In ANSI CL, symbols and cons can no longer also be of type FUNCTION.
 
67
(deftest function.10
 
68
  (loop for x in *universe*
 
69
        when (and (or (numberp x) (characterp x)
 
70
                      (symbolp x) (consp x)
 
71
                      (typep x 'array))
 
72
                  (typep x 'function))
 
73
        collect x)
 
74
  nil)
 
75
 
 
76
(deftest function.11
 
77
  (flet ((%f () nil)) (typep '%f 'function))
 
78
  nil)
 
79
 
 
80
(deftest function.12
 
81
  (flet ((%f () nil)) (not-mv (typep #'%f 'function)))
 
82
  nil)
 
83
 
 
84
(deftest function.13
 
85
  (labels ((%f () nil)) (not-mv (typep #'%f 'function)))
 
86
  nil)
 
87
 
 
88
;;; "If name is a function name, the functional definition of that
 
89
;;; name is that established by the innermost lexically enclosing flet,
 
90
;;; labels, or macrolet form, if there is one." (page for FUNCTION, sec. 5.3)
 
91
;;;            ^^^^^^^^
 
92
;;;(deftest function.14
 
93
;;;  (macrolet ((%f () nil)) (not-mv (typep #'%f 'function)))
 
94
;;;  nil)
 
95
 
 
96
;;; Tests of FUNCTION type specifiers
 
97
 
 
98
(deftest function.14
 
99
  (flet ((%f () nil))
 
100
    (declare (optimize safety debug))
 
101
    (let ((f #'%f))
 
102
      (declare (type (function () null) f))
 
103
      (funcall f)))
 
104
  nil)