1.0.23.21: Stack allocated conses for MIPS.
[sbcl.git] / tests / smoke.impure.lisp
1 ;;;; rudimentary tests ("smoke tests") for miscellaneous stuff which
2 ;;;; doesn't seem to deserve specialized files at the moment
3
4 ;;;; This software is part of the SBCL system. See the README file for
5 ;;;; more information.
6 ;;;;
7 ;;;; While most of SBCL is derived from the CMU CL system, the test
8 ;;;; files (like this one) were written from scratch after the fork
9 ;;;; from CMU CL.
10 ;;;;
11 ;;;; This software is in the public domain and is provided with
12 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
13 ;;;; more information.
14
15 (cl:in-package :cl-user)
16
17 ;;; ROOM should run without signalling an error. (bug 247)
18 (room)
19 (room t)
20 (room nil)
21
22 ;;; COPY-SYMBOL should work without signalling an error, even if the
23 ;;; symbol is unbound.
24 (copy-symbol 'foo)
25 (copy-symbol 'bar t)
26 (defvar *baz* nil)
27 (copy-symbol '*baz* t)
28
29 ;;; SETQ should return its value.
30 (assert (typep (setq *baz* 1) 'integer))
31 (assert (typep (in-package :cl-user) 'package))
32
33 ;;; PROFILE should run without obvious breakage
34 (progn
35   (defun profiled-fun ()
36     (random 1d0))
37   (profile profiled-fun)
38   (loop repeat 100000 do (profiled-fun))
39   (report))
40
41 ;;; Defconstant should behave as the documentation specifies,
42 ;;; including documented condition type.
43 (defun oidentity (x) x)
44 (defconstant +const+ 1)
45 (assert (= (oidentity +const+) 1))
46 (let ((error (nth-value 1 (ignore-errors (defconstant +const+ 2)))))
47   (assert (typep error 'sb-ext:defconstant-uneql))
48   (assert (= (sb-ext:defconstant-uneql-old-value error) 1))
49   (assert (= (sb-ext:defconstant-uneql-new-value error) 2))
50   (assert (eql (sb-ext:defconstant-uneql-name error) '+const+)))
51 (assert (= (oidentity +const+) 1))
52 (handler-bind
53     ((sb-ext:defconstant-uneql
54          (lambda (c) (abort c))))
55   (defconstant +const+ 3))
56 (assert (= (oidentity +const+) 1))
57 (handler-bind
58     ((sb-ext:defconstant-uneql
59          (lambda (c) (continue c))))
60   (defconstant +const+ 3))
61 (assert (= (oidentity +const+) 3))
62
63 ;;; MULTIPLE-VALUE-BIND and lambda list keywords
64 (multiple-value-bind (&rest &optional &key &allow-other-keys)
65     (values 1 2 3)
66   (assert (= &rest 1))
67   (assert (= &optional 2))
68   (assert (= &key 3))
69   (assert (null &allow-other-keys)))
70
71 (let ((fn (lambda (&foo &rest &bar) (cons &foo &bar))))
72   (assert (equal (funcall fn 1) '(1)))
73   (assert (equal (funcall fn 1 2 3) '(1 2 3))))
74
75 ;;; success