Changeset 9341


Ignore:
Timestamp:
May 1, 2008, 4:50:56 PM (11 years ago)
Author:
gz
Message:

More tests

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/tests/ansi-tests/ccl.lsp

    r9330 r9341  
    55(in-package :cl-test)
    66
     7(defun test-source-file (format-string &rest format-args)
     8  (let ((file "temp.dat"))
     9    (with-open-file (s file :direction :output :if-exists :supersede)
     10      (apply #'format s format-string format-args)
     11      (terpri s)
     12      (truename s))))
    713
    8 ;;; Regression tests
     14(defun test-compile (lambda-or-file &key suppress-warnings)
     15  ;; Compile in a more-or-less standard environment
     16  (let ((ccl::*suppress-compiler-warnings* suppress-warnings)
     17        (ccl::*nx-speed* 1)
     18        (ccl::*nx-space* 1)
     19        (ccl::*nx-safety* 1)
     20        (ccl::*nx-cspeed* 1)
     21        (ccl::*nx-debug* 1))
     22    (if (consp lambda-or-file)
     23      (compile nil lambda-or-file)
     24      (compile-file lambda-or-file))))
     25
     26;;; CCL-specific regression tests, for CCL-specific behavior.
    927
    1028(deftest ccl.40199  ;; fixed in r9116 and r9121
     
    5371  t)
    5472
     73(deftest ccl.bug#235
     74    (handler-case
     75        (test-compile '(lambda (x)
     76                        (make-array x :element-type 'ccl.bug#235-unknown-type)))
     77      (warning (c) (when (typep c 'ccl::compiler-warning)
     78                     (ccl::compiler-warning-warning-type c))))
     79  :unknown-type-declaration)
     80
     81
    5582(defclass ccl.bug#285 () ())
    5683
     
    6491
    6592(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)
     93    (and (test-compile '(lambda ()
     94                         (typep nil '(or ccl.bug#286-unknown-type-1 null)))
     95                       :suppress-warnings t)
     96         (test-compile '(lambda ()
     97                         (ccl:require-type nil '(or ccl.bug#286-unknown-type-2 null)))
     98                       :suppress-warnings t)
     99         :no-crash)
     100  :no-crash)
    74101
    75102
     
    80107      (let ((*trace-output* (make-broadcast-stream))) ;; don't care about trace output
    81108        (prog1
    82             (ccl.bug#287 :good)
     109            (ccl.bug#287 :no-crash)
    83110          (untrace))))
    84   :good)
     111  :no-crash)
    85112
    86113
    87114(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)
     115    (let ((file (test-source-file "(defmacro ccl.41226 (x) (eq (caar x)))")))
     116      (test-compile file :suppress-warnings t)
     117      :no-crash)
     118  :no-crash)
    97119
    98120(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)
     121    (let ((file (test-source-file "(prog1 (declare (ignore foo)))")))
     122      (test-compile file :suppress-warnings t)
     123      :no-crash)
     124  :no-crash)
     125
     126(deftest ccl.40055-1
     127    (let ((file (test-source-file "
     128
     129 (defclass ccl.40055-1-class () ())
     130 (eval-when (eval compile load)
     131  (defstruct ccl.40055-1-struct (slot nil :type (or ccl.40055-1-class null))))
     132 (defun ccl.40055-1-fn ()
     133   (make-array 0 :element-type 'ccl.40055-1-struct))
     134 ")))
     135      (handler-case
     136          (progn (test-compile file) :no-warnings)
     137        (warning (c) (format nil "~a" c))))
     138  :no-warnings)
     139
     140(deftest ccl.40055-2
     141    (let ((file (test-source-file "
     142
     143 (defclass ccl.40055-2-class () ())
     144 (defstruct ccl.40055-2-struct (slot nil :type (or ccl.40055-2-class null)))
     145 (defun ccl.40055-2-class-arr ()
     146   (make-array 0 :element-type 'ccl.40055-2-class))
     147 (defun ccl.40055-2-struct-arr ()
     148   (make-array 0 :element-type 'ccl.40055-2-struct))
     149 (defun ccl.40055-2-struct-arr ()
     150   (make-array 0 :element-type '(or (member 17 32) ccl.40055-2-struct)))
     151 (defun ccl.40055-2-fn (x) (setf (ccl.40055-2-struct-slot x) nil))
     152 ")))
     153      (handler-case
     154          (progn (test-compile file) :no-warnings)
     155        (warning (c) c)))
     156  :no-warnings)
     157
     158
     159(deftest ccl.40055-3
     160    (let ((file (test-source-file "
     161 (defclass ccl.40055-3-class () ())
     162 (defun ccl.40055-3-cfn () (require-type nil '(or ccl.40055-3-class null)))
     163 (defstruct ccl.40055-3-struct () ())
     164 (defun ccl.40055-3-rfn () (require-type nil '(or ccl.40055-3-struct null)))")))
     165      (test-compile file)
     166      :no-crash)
     167  :no-crash)
Note: See TracChangeset for help on using the changeset viewer.