arithmetic-error.lsp 2.21 KB
Newer Older
1 2 3 4 5 6 7 8
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Contains: Tests of ARITHMETIC-ERROR condition and associated accessors

(in-package :cl-test)

(deftest arithmethic-error.1
  (let ((a (make-condition 'arithmetic-error
sds's avatar
sds committed
9 10
                           :operation '/
                           :operands '(0 0))))
11 12 13 14 15 16 17 18 19
    (values
     (notnot (typep a 'arithmetic-error))
     (notnot (typep a (find-class 'arithmetic-error)))
     (multiple-value-list (arithmetic-error-operation a))
     (multiple-value-list (arithmetic-error-operands a))))
  t t (/) ((0 0)))

(deftest arithmethic-error.2
  (let ((a (make-condition 'arithmetic-error
sds's avatar
sds committed
20 21
                           :operation #'/
                           :operands '(0 0))))
22 23 24 25 26 27 28 29 30 31 32 33 34
    (values
     (notnot (typep a 'arithmetic-error))
     (notnot (typep a 'error))
     (notnot (typep a 'serious-condition))
     (notnot (typep a 'condition))
     (notnot (typep a (find-class 'arithmetic-error)))
     (notnot (typep (arithmetic-error-operation a) 'function))
     (funcall (arithmetic-error-operation a) 1 2)
     (multiple-value-list (arithmetic-error-operands a))))
  t t t t t t 1/2 ((0 0)))

(deftest arithmetic-error.3
  (let ((a (make-condition 'arithmetic-error
sds's avatar
sds committed
35 36
                           :operation '/
                           :operands '(0 0))))
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
    (macrolet
     ((%m (z) z))
     (values
      (arithmetic-error-operation (expand-in-current-env (%m a)))
      (arithmetic-error-operands (expand-in-current-env (%m a))))))
  / (0 0))

;;; Error tests

(deftest arithmetic-error-operation.error.1
  (signals-error (arithmetic-error-operation) program-error)
  t)

(deftest arithmetic-error-operation.error.2
  (signals-error (arithmetic-error-operation
sds's avatar
sds committed
52 53 54 55
                  (make-condition 'arithmetic-error :operation '/
                                  :operands '(1 0))
                  nil)
                 program-error)
56 57 58 59 60 61 62 63
  t)

(deftest arithmetic-error-operands.error.1
  (signals-error (arithmetic-error-operands) program-error)
  t)

(deftest arithmetic-error-operands.error.2
  (signals-error (arithmetic-error-operands
sds's avatar
sds committed
64 65 66 67
                  (make-condition 'arithmetic-error :operation '/
                                  :operands '(1 0))
                  nil)
                 program-error)
68
  t)