Changeset 9863


Ignore:
Timestamp:
Jul 1, 2008, 5:50:39 PM (11 years ago)
Author:
gz
Message:

Add tests for #294, also tests for maintaining tracing through file loading

File:
1 edited

Legend:

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

    r9843 r9863  
    1212      (truename s))))
    1313
    14 (defun test-compile (lambda-or-file &key suppress-warnings (safety 1) load)
     14(defun test-compile (lambda-or-file &rest args &key hide-warnings (safety 1) &allow-other-keys)
    1515  ;; Compile in a more-or-less standard environment
    16   (let ((ccl::*suppress-compiler-warnings* suppress-warnings)
     16  (let ((*error-output* (if hide-warnings (make-broadcast-stream) *error-output*))
    1717        (ccl::*nx-speed* 1)
    1818        (ccl::*nx-space* 1)
     
    2020        (ccl::*nx-cspeed* 1)
    2121        (ccl::*nx-debug* 1))
     22    (remf args :hide-warnings)
     23    (remf args :safety)
    2224    (if (consp lambda-or-file)
    23       (compile nil lambda-or-file)
    24       (compile-file lambda-or-file :load load))))
     25      (apply #'compile nil lambda-or-file args)
     26      (apply #'compile-file lambda-or-file args))))
    2527
    2628;;; CCL-specific regression tests, for CCL-specific behavior.
     
    4749
    4850(deftest ccl.40207  ;; fixed in r9163 and r9165
     51  (progn
     52    (fmakunbound 'cl-test::ccl.40207-fn)
    4953    ;; Check that these compile-time errors don't abort compilation.
    50     (and (typep (lambda (x) (setq x)) 'function)
    51          (typep (lambda (x) (setf x)) 'function)
    52          (typep (lambda (((foo))) foo) 'function)
    53          :good)
     54    (let* ((test (test-source-file "(defun cl-test::ccl.40207-fn ()
     55                                     (and (typep (lambda (x) (setq x)) 'function)
     56                                          (typep (lambda (x) (setf x)) 'function)
     57                                          (typep (lambda (((foo))) foo) 'function)
     58                                          :good))")))
     59      (test-compile test :hide-warnings t :load t)
     60      (funcall 'cl-test::ccl.40207-fn)))
    5461  :good)
    5562
     
    7178  t)
    7279
     80
    7381(deftest ccl.bug#235
    7482    (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))))
     83        (test-compile `(lambda (x)
     84                         (make-array x :element-type ',(gensym))))
     85      (warning (c)
     86        (when (typep c 'ccl::compiler-warning)
     87          (ccl::compiler-warning-warning-type c))))
    7988  :unknown-type-declaration)
    8089
     
    93102    (and (test-compile '(lambda ()
    94103                         (typep nil '(or ccl.bug#286-unknown-type-1 null)))
    95                        :suppress-warnings t)
     104                       :hide-warnings t)
    96105         (test-compile '(lambda ()
    97106                         (ccl:require-type nil '(or ccl.bug#286-unknown-type-2 null)))
    98                        :suppress-warnings t)
     107                       :hide-warnings t)
    99108         :no-crash)
    100109  :no-crash)
     
    114123(deftest ccl.41226
    115124    (let ((file (test-source-file "(defmacro ccl.41226 (x) (eq (caar x)))")))
    116       (test-compile file :suppress-warnings t)
     125      (handler-case
     126          (test-compile file :hide-warnings t :break-on-program-errors nil)
     127        ;; Might still signal due to macros being implicitly eval-when compile.
     128        ;; Ok so long as it's not the make-load-form error (which is not a program-error).
     129        (program-error () nil))
    117130      :no-crash)
    118131  :no-crash)
     
    120133(deftest ccl.bug#288
    121134    (let ((file (test-source-file "(prog1 (declare (ignore foo)))")))
    122       (test-compile file :suppress-warnings t)
     135      (test-compile file :hide-warnings t)
    123136      :no-crash)
    124137  :no-crash)
     
    126139(deftest ccl.bug#288-1 ;; follow-on bug, not really the same
    127140    (let ((file (test-source-file "(defun cl-test::ccl.bug#288-1-fn ((x integer)) x)")))
    128       (test-compile file :suppress-warnings t :load t)
     141      (test-compile file :hide-warnings t :load t)
    129142      (handler-case
    130143          (progn (ccl.bug#288-1-fn 17) :no-warnings)
     
    270283      (ccl.42923 'foo :y 1 :z 2 :a 1 :b 2 :c 3))
    271284  foo)
     285
     286(deftest ccl.bug#294-1
     287  (handler-case
     288      (let ((ccl::*nx-safety* 1)) ;; At safety 3, we don't know from EQ...
     289        (eval '(defun cl-test::ccl.bug#294-1 (x y)
     290                (eq x) y)))
     291    (program-error () :program-error))
     292  :program-error)
     293
     294(deftest ccl.bug#294-2
     295  (let* ((file (test-source-file
     296                "(defun cl-test::ccl.bug#294-2 (x y) (eq x) y)")))
     297    (fmakunbound ' cl-test::ccl.bug#294-2)
     298    (handler-case (test-compile file :break-on-program-errors t)
     299      (program-error () :program-error)))
     300  :program-error)
     301
     302(deftest ccl.buf#294-3
     303  (let* ((file (test-source-file
     304                "(defun cl-test::ccl.bug#294-3 (x y) (eq x) y)"))
     305         (warnings 0))
     306    (fmakunbound ' cl-test::ccl.bug#294-3)
     307    (list
     308     (let ((*error-output* (make-broadcast-stream)))
     309       (handler-case
     310           (handler-bind ((warning (lambda (c) (incf warnings))))
     311             (test-compile file :break-on-program-errors :defer))
     312         (error (c) :error)))
     313     warnings))
     314  (:error 1))
     315
     316
     317(deftest ccl.buf#294-4
     318  (let* ((file (test-source-file
     319                "(defun cl-test::ccl.bug#294-4 (x y) (eq x) y)"))
     320         (warnings 0))
     321    (fmakunbound 'cl-test::ccl.bug#294-4)
     322    (list
     323     (let ((*error-output* (make-broadcast-stream)))
     324       (handler-bind ((warning (lambda (c) (incf warnings))))
     325         (test-compile file :break-on-program-errors nil :load t))
     326       (handler-case (and (fboundp 'cl-test::ccl.bug#294-4)
     327                          (funcall 'cl-test::ccl.bug#294-4 1 2))
     328         (program-error (c) :program-error)))
     329     warnings))
     330  (:program-error 1))
     331
     332
     333(deftest ccl.43101a
     334    (progn
     335      (untrace)
     336      (fmakunbound 'ccl.43101a-fun)
     337      (defun ccl.43101a-fun (x) x)
     338      (trace ccl.43101a-fun)
     339      (let ((file (test-source-file "(defun cl-test::ccl.43101a-fun (x) (1+ x))")))
     340        (test-compile file :hide-warnings t :load t))
     341      (not (equal "" (with-output-to-string (*trace-output*)
     342                       (assert (eql (ccl.43101a-fun 4) 5))))))
     343  t)
     344
     345(deftest ccl.43101b
     346    (progn
     347      (untrace)
     348      (fmakunbound 'ccl.43101b-gf)
     349      (defmethod ccl.43101b-gf (x) x)
     350      (trace ccl.43101b-gf)
     351      (let ((file (test-source-file "(defmethod cl-test::ccl.43101b-gf (x) (1+ x))")))
     352        (test-compile file :hide-warnings t :load t))
     353      (not (equal "" (with-output-to-string (*trace-output*)
     354                       (assert (eql (ccl.43101b-gf 4) 5))))))
     355  t)
     356
     357
    272358
    273359;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Note: See TracChangeset for help on using the changeset viewer.