source: trunk/source/tests/ansi-tests/compile.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 2.1 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Thu Oct 10 20:54:20 2002
4;;;; Contains: Tests for COMPILE, COMPILED-FUNCTION-P, COMPILED-FUNCTION
5
6(in-package :cl-test)
7
8(deftest compile.1
9  (progn
10    (fmakunbound 'compile.1-fn)
11    (values
12     (eval '(defun compile.1-fn (x) x))
13     (compiled-function-p 'compile.1-fn)
14     (let ((x (compile 'compile.1-fn)))
15       (or (eqt x 'compile.1-fn)
16           (notnot (compiled-function-p x))))
17     (compiled-function-p 'compile.1-fn)
18     (not (compiled-function-p #'compile.1-fn))
19     (fmakunbound 'compile.1-fn)))
20  compile.1-fn
21  nil
22  t
23  nil
24  nil
25  compile.1-fn)
26
27
28;;; COMPILE returns three values (function, warnings-p, failure-p)
29(deftest compile.2
30  (let* ((results (multiple-value-list
31                   (compile nil '(lambda (x y) (cons y x)))))
32         (fn (car results)))
33    (values (length results)
34            (funcall fn 'a 'b)
35            (second results)
36            (third results)))
37  3
38  (b . a)
39  nil
40  nil)
41
42;;; Compile does not coalesce literal constants
43(deftest compile.3
44  (let ((x (list 'a 'b))
45        (y (list 'a 'b)))
46    (and (not (eqt x y))
47         (funcall (compile nil `(lambda () (eqt ',x ',y))))))
48  nil)
49
50(deftest compile.4
51  (let ((x (copy-seq "abc"))
52        (y (copy-seq "abc")))
53    (and (not (eqt x y))
54         (funcall (compile nil `(lambda () (eqt ,x ,y))))))
55  nil)
56
57(deftest compile.5
58  (let ((x (copy-seq "abc")))
59    (funcall (compile nil `(lambda () (eqt ,x ,x)))))
60  t)
61
62(deftest compile.6
63  (let ((x (copy-seq "abc")))
64    (funcall (compile nil `(lambda () (eqt ',x ',x)))))
65  t)
66
67(deftest compile.7
68  (let ((x (copy-seq "abc")))
69    (eqt x (funcall (compile nil `(lambda () ,x)))))
70  t)
71
72(deftest compile.8
73  (let ((x (list 'a 'b)))
74    (eqt x (funcall (compile nil `(lambda () ',x)))))
75  t)
76
77(deftest compile.9
78  (let ((i 0) a b)
79    (values
80     (funcall (compile (progn (setf a (incf i)) nil)
81                       (progn (setf b (incf i)) '(lambda () 'z))))
82     i a b))
83  z 2 1 2)
84
85;;; Error tests
86
87(deftest compile.error.1
88  (signals-error (compile) program-error)
89  t)
90
91(deftest compile.error.2
92  (signals-error (compile nil '(lambda () nil) 'garbage)
93                 program-error)
94  t)
Note: See TracBrowser for help on using the repository browser.