1 ;;;; tests of backquote readmacro within the 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 ;; In the expression `(,@l1 a b ,@l2) is it preferable that we expand this
17 ;; as (APPEND L1 (LIST* 'A 'B L2)) or as (APPEND L1 '(A) '(B) L2)?
18 ;; The IR1 transform is designed to catch the latter case, but the expander
19 ;; returns the former, which probably favors speed over code size.
20 ;; This is perhaps an interesting reason to make expansion policy-sensitive.
21 ;; I'll test a case that definitely triggers the IR1 transform.
23 (defun list-backq-expr (l1) `(,@l1
,most-positive-fixnum a
))
24 (defun obviously-constant-list () '(#.most-positive-fixnum a
))
26 (defun vector-backq-expr () `#(foo ,char-code-limit
)) ; no xform, but folded
27 (defun obviously-constant-vector () #(foo #.char-code-limit
))
29 (defun list-fun-referenced-constants (f)
30 (let ((code (sb-kernel:fun-code-header f
)))
31 (loop for i from sb-vm
:code-constants-offset
32 below
(sb-kernel:get-header-data code
)
33 collect
(sb-kernel:code-header-ref code i
))))
35 (test-util:with-test
(:name
:backquote-ir1-simplifier
)
36 ;; The pre-tests show that the backquoted expression did not compress
37 ;; (,char-code-limit x) into a constant, nor for the vector.
38 ;; Thus the IR1 optimization must do it in order for this test to pass.
39 (assert (equal (macroexpand '`(,@l1
,char-code-limit x
))
40 '(APPEND l1
(LIST* char-code-limit
'(X)))))
41 (assert (equal (macroexpand '`#(,char-code-limit foo
))
42 '(VECTOR char-code-limit
'foo
)))
44 (assert (eq (obviously-constant-list) (list-backq-expr nil
)))
46 ;; FIXME: do we not coalesce vector constants? I thought this should pass.
48 (assert (eq (obviously-constant-vector) (vector-backq-expr)))
50 ;; Compiled code should reference a constant vector.
51 (assert (member (vector 'foo char-code-limit
)
52 (list-fun-referenced-constants #'vector-backq-expr
)