compile.lsp 2.17 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
;-*- 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 compiled-function-p.1
  (some #'(lambda (obj)
	     (if (compiled-function-p obj)
		 (not (typep obj 'compiled-function))
	       (typep obj 'compiled-function)))
	 *universe*)
  nil)

(deftest compiled-function-p.2
  (compiled-function-p '(lambda (x y) (cons y x)))
  nil)

(deftest compiled-function-p.3
  (not (compiled-function-p (compile nil '(lambda (y x) (cons x y)))))
  nil)

(deftest compile.1
  (progn
    (fmakunbound 'compile.1-fn)
    (values
     (defun compile.1-fn (x) x)
     (compiled-function-p 'compile.1-fn)
     (compile 'compile.1-fn)
     (compiled-function-p 'compile.1-fn)
     (not (compiled-function-p #'compile.1-fn))
     (fmakunbound 'compile.1-fn)))
  compile.1-fn
  nil
  compile.1-fn
  nil
  nil
  compile.1-fn)


;;; COMPILE returns three values (function, warnings-p, failure-p)
(deftest compile.2
  (let* ((results (multiple-value-list
		   (compile nil '(lambda (x y) (cons y x)))))
	 (fn (car results)))
    (values (length results)
	    (funcall fn 'a 'b)
	    (second results)
	    (third results)))
  3
  (b . a)
  nil
  nil)

;;; Compile does not coalesce literal constants
(deftest compile.3
  (let ((x (list 'a 'b))
	(y (list 'a 'b)))
60 61
    (and (not (eqt x y))
	 (funcall (compile nil `(lambda () (eqt ',x ',y))))))
62 63 64 65 66
  nil)

(deftest compile.4
  (let ((x (copy-seq "abc"))
	(y (copy-seq "abc")))
67 68
    (and (not (eqt x y))
	 (funcall (compile nil `(lambda () (eqt ,x ,y))))))
69 70 71 72
  nil)

(deftest compile.5
  (let ((x (copy-seq "abc")))
73
    (funcall (compile nil `(lambda () (eqt ,x ,x)))))
74 75 76 77
  t)

(deftest compile.6
  (let ((x (copy-seq "abc")))
78
    (funcall (compile nil `(lambda () (eqt ',x ',x)))))
79 80
  t)

81 82
(deftest compile.7
  (let ((x (copy-seq "abc")))
83
    (eqt x (funcall (compile nil `(lambda () ,x)))))
84
  t)
85

86 87
(deftest compile.8
  (let ((x (list 'a 'b)))
88
    (eqt x (funcall (compile nil `(lambda () ',x)))))
89
  t)
90 91 92 93 94 95 96 97

(deftest compile.9
  (classify-error (compile))
  program-error)

(deftest compile.10
  (classify-error (compile nil '(lambda () nil) 'garbage))
  program-error)