1 ;;;; tests of the fop compiler
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
14 (in-package "CL-USER")
16 ;; Can't use normal ASSERT, since it is not fopcompilable...
17 (defun assert* (value)
19 (error "assert failed")))
21 ;;; Test that the forms that are supposed to be fopcompilable are, and
22 ;;; the ones that aren't aren't. The body might contain further tests to
23 ;;; ensure that the fopcompiled code works as intended.
24 (defmacro fopcompile-test (fopcompilable-p &body body)
25 (assert (eql (sb-c::fopcompilable-p `(progn ,@body))
36 (assert* (eql a 4)))))
41 (assert* (eql a 6)))))
45 (assert* (eql (funcall (lambda () a)) 7))))
49 (assert* (eql (funcall (lambda () a)) 8))))
57 (let* ((a (lambda () 1)))
67 (b (funcall (lambda () a))))
74 (assert* (eql b 10)))))
80 (assert* (eql b 13)))))
82 (setf (symbol-value 'fopcompile-test-foo) 1)
83 (assert* (eql fopcompile-test-foo 1))
85 ;;; Ensure that we're passing sensible environments to macros during
86 ;;; fopcompilation. Reported by Samium Gromoff.
88 (defmacro bar (vars &environment env)
90 (mapcar #'car (sb-c::lexenv-vars env)))))
92 (symbol-macrolet ((foo 1))
93 (let* ((x (bar (foo)))