tests/backq.impure-cload.lisp

   1 ;;;; tests of backquote readmacro within the compiler
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   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
   8 ;;;; from CMU CL.
   9 ;;;;
  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.
  13
  14 (in-package "CL-USER")
  15
  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.
  22
  23 (defun list-backq-expr (l1) `(,@l1 ,most-positive-fixnum a))
  24 (defun obviously-constant-list () '(#.most-positive-fixnum a))
  25
  26 (defun vector-backq-expr () `#(foo ,char-code-limit)) ; no xform, but folded
  27 (defun obviously-constant-vector () #(foo #.char-code-limit))
  28
  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))))
  34
  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)))
  43
  44   (assert (eq (obviously-constant-list) (list-backq-expr nil)))
  45
  46   ;; FIXME: do we not coalesce vector constants? I thought this should pass.
  47   #+nil
  48   (assert (eq (obviously-constant-vector) (vector-backq-expr)))
  49
  50   ;; Compiled code should reference a constant vector.
  51   (assert (member (vector 'foo char-code-limit)
  52                   (list-fun-referenced-constants #'vector-backq-expr)
  53                   :test #'equalp)))