tests/eval.impure.lisp

   1 ;;;; various tests of EVAL with side effects
   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 ;;;; Note: this stuff gets loaded in (by LOAD) and is therefore
  15 ;;;; evaluated by EVAL, rather than compiled and then loaded; this is
  16 ;;;; why this idiom (a sequence of top-level forms) works as a test of
  17 ;;;; EVAL.
  18
  19 (cl:in-package :cl-user)
  20
  21 ;;; Until sbcl-0.7.9.x, EVAL was not correctly treating LOCALLY,
  22 ;;; MACROLET and SYMBOL-MACROLET, which should preserve top-levelness
  23 ;;; of their body forms:
  24
  25 ;;; LOCALLY
  26 (locally (defstruct locally-struct a (b t)))
  27
  28 (let ((x (make-locally-struct :a 1)))
  29   (assert (eql (locally-struct-a x) 1))
  30   (assert (eql (locally-struct-b x) t)))
  31
  32 (locally
  33   (defmacro locally-macro (x) `(+ ,x 1))
  34   (assert (= (locally-macro 3) 4)))
  35
  36 (locally (declare (special x))
  37   (defun locally-special-test ()
  38     x)
  39   (defun locally-special-test-aux ()
  40     (let ((x 1))
  41       (declare (special x))
  42       (locally-special-test)))
  43   (assert (= (locally-special-test-aux) 1)))
  44
  45 ;;; MACROLET
  46 (macrolet ()
  47   (defstruct macrolet-struct a (b t)))
  48
  49 (let ((x (make-macrolet-struct :a 1)))
  50   (assert (eql (macrolet-struct-a x) 1))
  51   (assert (eql (macrolet-struct-b x) t)))
  52
  53 (macrolet ()
  54   (defmacro macrolet-macro (x) `(+ ,x 1))
  55   (assert (= (macrolet-macro 3) 4)))
  56
  57 (locally (declare (special x))
  58   (defun macrolet-special-test ()
  59     x)
  60   (defun macrolet-special-test-aux ()
  61     (let ((x 1))
  62       (declare (special x))
  63       (macrolet-special-test)))
  64   (assert (= (macrolet-special-test-aux) 1)))
  65
  66 (macrolet ((foo (x) `(macrolet-bar ,x)))
  67   (defmacro macrolet-bar (x) `(+ ,x 1))
  68   (assert (= (foo 1) 2)))
  69
  70 ;;; SYMBOL-MACROLET
  71 (symbol-macrolet ()
  72   (defstruct symbol-macrolet-struct a (b t)))
  73
  74 (let ((x (make-symbol-macrolet-struct :a 1)))
  75   (assert (eql (symbol-macrolet-struct-a x) 1))
  76   (assert (eql (symbol-macrolet-struct-b x) t)))
  77
  78 (symbol-macrolet ()
  79   (defmacro symbol-macrolet-macro (x) `(+ ,x 1))
  80   (assert (= (symbol-macrolet-macro 3) 4)))
  81
  82 (locally (declare (special x))
  83   (defun symbol-macrolet-special-test ()
  84     x)
  85   (defun symbol-macrolet-special-test-aux ()
  86     (let ((x 1))
  87       (declare (special x))
  88       (symbol-macrolet-special-test)))
  89   (assert (= (symbol-macrolet-special-test-aux) 1)))
  90
  91 (symbol-macrolet ((foo (symbol-macrolet-bar 1)))
  92   (defmacro symbol-macrolet-bar (x) `(+ ,x 1))
  93   (assert (= foo 2)))
  94
  95 ;;; Bug reported by Paul Dietz: CONSTANTP on a self-evaluating object
  96 ;;; must return T
  97
  98 (assert (constantp (find-class 'symbol)))
  99 (assert (constantp #p""))
 100
 101 ;;; DEFPARAMETER must assign a dynamic variable
 102 (let ((var (gensym)))
 103   (assert (equal (eval `(list (let ((,var 1))
 104                                 (defparameter ,var 2)
 105                                 ,var)
 106                               ,var))
 107                  '(1 2))))
 108
 109 \f
 110 ;;; success
 111 (sb-ext:quit :unix-status 104)