1 ;;;; miscellaneous tests of compiling toplevel forms
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.
16 ;;; Exercise a compiler bug (by causing a call to ERROR).
18 ;;; This bug was in sbcl-0.6.11.6.
20 (declare (type (mod 1000) a b
))
21 (let ((tmp (= 10 (+ (incf a
) (incf a
) (incf b
) (incf b
)))))
22 (or tmp
(error "TMP not true"))))
24 ;;; Exercise a (byte-)compiler bug by causing a call to ERROR, not
25 ;;; because the symbol isn't defined as a variable, but because
26 ;;; TYPE-ERROR in SB-KERNEL::OBJECT-NOT-TYPE-ERROR-HANDLER:
27 ;;; 0 is not of type (OR FUNCTION SB-KERNEL:FDEFN).
28 ;;; Correct behavior is to warn at compile time because the symbol
29 ;;; isn't declared as a variable, but to set its SYMBOL-VALUE anyway.
31 ;;; This bug was in sbcl-0.6.11.13.
32 (print (setq improperly-declared-var
'(1 2)))
33 (assert (equal (symbol-value 'improperly-declared-var
) '(1 2)))
34 (makunbound 'improperly-declared-var
)
35 ;;; This is a slightly different way of getting the same symptoms out
36 ;;; of the sbcl-0.6.11.13 byte compiler bug.
37 (print (setq *print-level
* *print-level
*))
39 ;;; PROGV with different numbers of variables and values
42 (assert (equal (list a
(progv '(a b
) '(:a
:b
:c
)
43 (assert (eq (symbol-value 'nil
) nil
))
44 (list (symbol-value 'a
) (symbol-value 'b
)))
47 (assert (equal (list a
(progv '(a b
) '(:a
:b
)
48 (assert (eq (symbol-value 'nil
) nil
))
49 (list (symbol-value 'a
) (symbol-value 'b
)))
52 (assert (not (boundp 'b
))))
55 (declare (special a b
))
56 (assert (equal (list a b
(progv '(a b
) '(:a
)
57 (assert (eq (symbol-value 'nil
) nil
))
58 (assert (not (boundp 'b
)))
63 ;;; bug in LOOP, reported by ??? on c.l.l
66 when
(symbolp x
) return x
69 (assert (equal (foo '(1 2 #\a 3)) '((1) (2))))
70 (assert (equal (foo '(1 2 x
3)) 'x
)))
74 ;;; Verify type checking policy in full calls: the callee is supposed
75 ;;; to perform check, but the results should not be used before the
76 ;;; check will be actually performed.
79 (declare (optimize (safety 3)))
81 (declare (type (simple-array (unsigned-byte 32) (*)) a
))
82 (declare (type (function (fixnum)) f
))
83 (funcall f
(aref a
0))))
85 (eval `(let ((n (1+ most-positive-fixnum
)))
86 (if (not (typep n
'(unsigned-byte 32)))
88 "~@<This test is written for platforms with ~
89 ~@<(proper-subtypep 'fixnum '(unsigned-byte 32))~:@>.~:@>")
92 (lambda (x) (when (eql x n
) (return t
)))
93 (make-array 1 :element-type
'(unsigned-byte 32)