;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Mon Oct  7 07:34:29 2002
;;;; Contains: Tests for type FUNCTION and the special form FUNCTION



;;;
;;; Note! There are significant incompatibilities between CLTL1 and ANSI CL
;;; in the meaning of FUNCTION and FUNCTIONP.
;;;

(deftest function.1
  (typep nil 'function)
  nil)

;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL.
;;; In ANSI CL, symbols are no longer of type FUNCTION.
(deftest function.2
  (typep 'identity 'function)
  nil)

(deftest function.3
  (not-mv (typep #'identity 'function))
  nil)

(deftest function.4
  (loop for x in *cl-symbol-names*
        for s = (find-symbol x "CL")
        for f = (and (fboundp s)
                     (symbol-function s)
                     (not (special-operator-p s))
                     (not (macro-function s))
                     (symbol-function s))
        unless (or (null f)
                   (typep f 'function))
        collect x)
  nil)

(deftest function.5
  (typep '(setf car) 'function)
  nil)

;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL.
;;; In ANSI CL, lambda forms are no longer of type FUNCTION.
(deftest function.6
  (typep '(lambda (x) x) 'function)
  nil)

(report-and-ignore-errors
 (defun (setf function-7-accessor) (y x) (setf (car x) y) y))

(deftest function.7
  (not-mv (typep #'(setf function-7-accessor) 'function))
  nil)

(deftest function.8
  (not-mv (typep #'(lambda (x) x) 'function))
  nil)

(deftest function.9
  (not-mv (typep (compile nil '(lambda (x) x)) 'function))
  nil)

;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL.
;;; In ANSI CL, symbols and cons can no longer also be of type FUNCTION.
(deftest function.10
  (check-predicate (typef '(not (and (or number character symbol
                                         cons array)
                                     function))))
  nil)

(deftest function.11
  (flet ((%f () nil)) (typep '%f 'function))
  nil)

(deftest function.12
  (flet ((%f () nil)) (not-mv (typep #'%f 'function)))
  nil)

(deftest function.13
  (labels ((%f () nil)) (not-mv (typep #'%f 'function)))
  nil)

;;; "If name is a function name, the functional definition of that
;;; name is that established by the innermost lexically enclosing flet,
;;; labels, or macrolet form, if there is one." (page for FUNCTION, sec. 5.3)
;;;            ^^^^^^^^
;;;(deftest function.14
;;;  (macrolet ((%f () nil)) (not-mv (typep #'%f 'function)))
;;;  nil)

;;; Tests of FUNCTION type specifiers

(deftest function.14
  (flet ((%f () nil))
    (declare (optimize safety debug))
    (let ((f #'%f))
      (declare (type (function () null) f))
      (funcall f)))
  nil)

(deftest function.15
  (flet ((%f (x) (declare (ignore x)) nil))
    (declare (ftype (function (nil) nil) %f))
    :good)
  :good)

(deftest function.16
  (flet ((%f (x) (declare (ignore x)) nil))
    (declare (ftype (function (t) null) %f))
    (values
     (%f 'a)
     (locally (declare (ftype (function (integer) t) %f))
              (%f 10))
     (%f 'b)))
  nil nil nil)

(deftest function.17
  (flet ((%f (&optional x) x))
    (declare (ftype (function (&optional integer) t) %f))
    (values (%f) (%f 10) (%f) (%f (1+ most-positive-fixnum))))
  nil 10 nil #.(1+ most-positive-fixnum))

(deftest function.18
  (flet ((%f (&rest x) x))
    (declare (ftype (function (&rest symbol) t) %f))
    (values (%f) (%f 'a) (%f 'a 'b 'c)))
  () (a) (a b c))

(deftest function.19
  (flet ((%f (&key foo bar) (list foo bar)))
    (declare (ftype (function (&key (:foo t) (:bar t)) list) %f))
    (values
     (%f) (%f :foo 1)
     (%f :foo 1 :foo 2)
     (%f :bar 'a)
     (%f :bar 'a :bar 'b)
     (%f :foo 'x :bar 'y)
     (%f :bar 'x :foo 'y)
     (%f :bar 'x :foo 'y :bar 'z :foo 'w)
     ))
  (nil nil)
  (1 nil)
  (1 nil)
  (nil a)
  (nil a)
  (x y)
  (y x)
  (y x))

(deftest function.20
  (flet ((%f (&key foo) foo))
    (declare (ftype (function (&key (:foo t) (:allow-other-keys t)) t) %f))
    (values (%f) (%f :foo 'a) (%f :allow-other-keys nil)
            (%f :allow-other-keys t :foo 'z)))
  nil a nil z)

(deftest function.21
  (flet ((%f (&key foo &allow-other-keys) foo))
    (declare (ftype (function (&key (:foo integer)) t) %f))
    (values (%f) (%f :foo 123)))
  nil 123)

(deftest function.22
  (flet ((%f (&key foo &allow-other-keys) foo))
    (declare (ftype (function (&key (:foo integer) (:bar t)) t) %f))
    (values (%f) (%f :foo 123) (%f :bar 'x) (%f :foo 12 :bar 'y)))
  nil 123 nil 12)

(deftest function.23
  (flet ((%f (&key foo &allow-other-keys) foo))
    (declare (ftype (function (&key (:foo integer) &allow-other-keys) t) %f))
    (values (%f) (%f :foo 123) (%f :bar 'x) (%f :foo 12 :bar 'y)))
  nil 123 nil 12)

(deftest function.24
  (flet ((%f (&rest r &key foo bar) (list r foo bar)))
    (declare (ftype (function (&rest symbol &key (:foo t) (:bar t)) list) %f))
    (values (%f) (%f :foo 'a) (%f :bar 'b) (%f :bar 'd :foo 'c)))
  (nil nil nil)
  ((:foo a) a nil)
  ((:bar b) nil b)
  ((:bar d :foo c) c d))