compile.lsp 2.17 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Thu Oct 10 20:54:20 2002
;;;; Contains: Tests for COMPILE, COMPILED-FUNCTION-P, COMPILED-FUNCTION

(in-package :cl-test)

(deftest compile.1
  (progn
    (fmakunbound 'compile.1-fn)
    (values
pfdietz's avatar
pfdietz committed
12
     (eval '(defun compile.1-fn (x) x))
13
     (compiled-function-p 'compile.1-fn)
pfdietz's avatar
pfdietz committed
14 15
     (let ((x (compile 'compile.1-fn)))
       (or (eqt x 'compile.1-fn)
sds's avatar
sds committed
16
           (notnot (compiled-function-p x))))
17 18 19 20 21
     (compiled-function-p 'compile.1-fn)
     (not (compiled-function-p #'compile.1-fn))
     (fmakunbound 'compile.1-fn)))
  compile.1-fn
  nil
pfdietz's avatar
pfdietz committed
22
  t
23 24 25 26 27 28 29 30
  nil
  nil
  compile.1-fn)


;;; COMPILE returns three values (function, warnings-p, failure-p)
(deftest compile.2
  (let* ((results (multiple-value-list
sds's avatar
sds committed
31 32
                   (compile nil '(lambda (x y) (cons y x)))))
         (fn (car results)))
33
    (values (length results)
sds's avatar
sds committed
34 35 36
            (funcall fn 'a 'b)
            (second results)
            (third results)))
37 38 39 40 41 42 43 44
  3
  (b . a)
  nil
  nil)

;;; Compile does not coalesce literal constants
(deftest compile.3
  (let ((x (list 'a 'b))
sds's avatar
sds committed
45
        (y (list 'a 'b)))
46
    (and (not (eqt x y))
sds's avatar
sds committed
47
         (funcall (compile nil `(lambda () (eqt ',x ',y))))))
48 49 50 51
  nil)

(deftest compile.4
  (let ((x (copy-seq "abc"))
sds's avatar
sds committed
52
        (y (copy-seq "abc")))
53
    (and (not (eqt x y))
sds's avatar
sds committed
54
         (funcall (compile nil `(lambda () (eqt ,x ,y))))))
55 56 57 58
  nil)

(deftest compile.5
  (let ((x (copy-seq "abc")))
59
    (funcall (compile nil `(lambda () (eqt ,x ,x)))))
60 61 62 63
  t)

(deftest compile.6
  (let ((x (copy-seq "abc")))
64
    (funcall (compile nil `(lambda () (eqt ',x ',x)))))
65 66
  t)

67 68
(deftest compile.7
  (let ((x (copy-seq "abc")))
69
    (eqt x (funcall (compile nil `(lambda () ,x)))))
70
  t)
71

72 73
(deftest compile.8
  (let ((x (list 'a 'b)))
74
    (eqt x (funcall (compile nil `(lambda () ',x)))))
75
  t)
76 77

(deftest compile.9
78 79 80
  (let ((i 0) a b)
    (values
     (funcall (compile (progn (setf a (incf i)) nil)
sds's avatar
sds committed
81
                       (progn (setf b (incf i)) '(lambda () 'z))))
82 83 84
     i a b))
  z 2 1 2)

pfdietz's avatar
pfdietz committed
85 86
;;; Error tests

87
(deftest compile.error.1
88 89
  (signals-error (compile) program-error)
  t)
90

91
(deftest compile.error.2
92
  (signals-error (compile nil '(lambda () nil) 'garbage)
sds's avatar
sds committed
93
                 program-error)
94
  t)