1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
;-*- 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
:operation '/
:operands '(0 0))))
(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
:operation #'/
:operands '(0 0))))
(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
:operation '/
:operands '(0 0))))
(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
(make-condition 'arithmetic-error :operation '/
:operands '(1 0))
nil)
program-error)
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
(make-condition 'arithmetic-error :operation '/
:operands '(1 0))
nil)
program-error)
t)
|
