1.0.23.21: Stack allocated conses for MIPS.
[sbcl.git] / tests / full-eval.impure.lisp
1 ;;;; various tests of the interpreter
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 #-sb-eval
15 (sb-ext:quit :unix-status 104)
16
17 (setf sb-ext:*evaluator-mode* :interpret)
18
19 (assert (not (typep (lambda ()) 'compiled-function)))
20
21 (assert (not (compiled-function-p (lambda ()))))
22
23 (let ((seen-forms (make-hash-table :test 'equal)))
24   (let ((*macroexpand-hook* (compile nil
25                                      `(lambda (fun form env)
26                                         (setf (gethash form ,seen-forms) t)
27                                         (funcall fun form env)))))
28     (let ((fun (lambda ()
29                  (when t nil))))
30       (assert (not (gethash '(when t nil) seen-forms)))
31       (funcall fun)
32       (assert (gethash '(when t nil) seen-forms)))))
33
34 ;;; defstruct constructor
35 (let ((sb-ext:*evaluator-mode* :interpret))
36   (eval '(progn
37           (defstruct evaluated-struct
38             (pointer nil)
39             (word 0 :type (unsigned-byte #.sb-vm:n-word-bytes))
40             (single 0.0 :type single-float)
41             (double 0.0d0 :type double-float)
42             (csingle (complex 0.0 0.0) :type (complex single-float))
43             (cdouble (complex 0.0d0 0.0d0) :type (complex double-float)))
44           (defvar *evaluated-struct* (make-evaluated-struct
45                                       :pointer :foo
46                                       :word 42
47                                       :single 1.23
48                                       :double 2.34d0
49                                       :csingle (complex 1.0 2.0)
50                                       :cdouble (complex 2.0d0 3.0d0)))
51           (assert (eq :foo (evaluated-struct-pointer *evaluated-struct*)))
52           (assert (eql 42 (evaluated-struct-word *evaluated-struct*)))
53           (assert (eql 1.23 (evaluated-struct-single *evaluated-struct*)))
54           (assert (eql 2.34d0 (evaluated-struct-double *evaluated-struct*)))
55           (assert (eql #c(1.0 2.0) (evaluated-struct-csingle *evaluated-struct*)))
56           (assert (eql #c(2.0d0 3.0d0) (evaluated-struct-cdouble *evaluated-struct*))))))
57