source: trunk/tests/ansi-tests/ccl.lsp @ 9330

Last change on this file since 9330 was 9330, checked in by gz, 12 years ago

More regression tests for recent bugs

File size: 3.2 KB
Line 
1;;;-*-Mode: LISP; Package: CL-TEST -*-
2;;;
3;;;   Copyright (C) 2008 Clozure Associates
4
5(in-package :cl-test)
6
7
8;;; Regression tests
9
10(deftest ccl.40199  ;; fixed in r9116 and r9121
11    (when (equalp (let ((*print-pretty* t))
12                    (format nil "~a" (make-array nil :initial-element 0)))
13                  "#0A0")
14      :good)
15  :good)
16
17(deftest ccl.40492 ;; fixed in r9134 and r9131
18    (let (obj (slot (gensym)))
19      (eval `(defclass ccl.40492 ()
20               ((,slot :accessor ,slot :initform :good))))
21      (setq obj (make-instance 'ccl.40492))
22      (ccl::%snap-reader-method (symbol-function slot))
23      (unwind-protect
24           (let ((*trace-output* (make-broadcast-stream))) ;; don't care about trace output
25             (ccl:trace-function slot)
26             (funcall slot obj))
27        (eval `(untrace ,slot))))
28  :good)
29
30(deftest ccl.40207  ;; fixed in r9163 and r9165
31    ;; Check that these compile-time errors don't abort compilation.
32    (and (typep (lambda (x) (setq x)) 'function)
33         (typep (lambda (x) (setf x)) 'function)
34         (typep (lambda (((foo))) foo) 'function)
35         :good)
36  :good)
37
38(deftest ccl.40927  ;; fixed in r9183 and r9184
39    (let ((s (make-string-output-stream))
40          (line1 "Line1
41")
42          (line2 "Line2"))
43      (count #\Newline (format nil "~a~&~a" line1 line2)))
44  1)
45
46(defstruct ccl.40055 (a 0 :type integer))
47
48(deftest ccl.40055 ;; fixed in r9237 and r9240
49    (locally
50        (declare (optimize (safety 3)))
51      (and (signals-error (make-ccl.40055 :a nil) type-error)
52           (signals-error (setf (ccl.40055-a (make-ccl.40055)) nil) type-error)))
53  t)
54
55(defclass ccl.bug#285 () ())
56
57(defmethod initialize-instance ((c ccl.bug#285) &rest args)
58  (declare (optimize (safety 3)))
59  (apply #'call-next-method c args))
60
61(deftest ccl.bug#285
62    (typep (make-instance 'ccl.bug#285) 'ccl.bug#285)
63  t)
64
65(deftest ccl.bug#286
66    (and (compile nil '(lambda ()
67                        (declare (optimize (speed 1) (safety 1)))
68                        (typep nil '(or ccl.bug#286-unknown-type-1 null))))
69         (compile nil '(lambda ()
70                        (declare (optimize (speed 1) (safety 1)))
71                        (ccl:require-type nil '(or ccl.bug#286-unknown-type-2 null))))
72         :good)
73  :good)
74
75
76(deftest ccl.bug#287
77    (progn
78      (defmethod ccl.bug#287 (x) x)
79      (trace ccl.bug#287)
80      (let ((*trace-output* (make-broadcast-stream))) ;; don't care about trace output
81        (prog1
82            (ccl.bug#287 :good)
83          (untrace))))
84  :good)
85
86
87(deftest ccl.41226
88    (let ((text "(defmacro ccl.41226 (x) (eq (caar x)))")
89          (file "temp.dat"))
90      (with-open-file (s file :direction :output :if-exists :supersede)
91        (write-string text s)
92        (terpri s))
93      (handler-bind ((warning #'muffle-warning)) ;; don't care about the warning
94        (compile-file file))
95      :good)
96  :good)
97
98(deftest ccl.bug#288
99    (let ((text "(prog1 (declare (ignore foo)))")
100          (file "temp.dat"))
101      (with-open-file (s file :direction :output :if-exists :supersede)
102        (write-string text s)
103        (terpri s))
104      (handler-bind ((warning #'muffle-warning)) ;; don't care about the warning
105        (compile-file file))
106      :good)
107  :good)
Note: See TracBrowser for help on using the repository browser.