1 | ;-*- Mode: Lisp -*- |
---|

2 | ;;;; Author: Paul Dietz |
---|

3 | ;;;; Contains: Tests of ARITHMETIC-ERROR condition and associated accessors |
---|

4 | |
---|

5 | (in-package :cl-test) |
---|

6 | |
---|

7 | (deftest arithmethic-error.1 |
---|

8 | (let ((a (make-condition 'arithmetic-error |
---|

9 | :operation '/ |
---|

10 | :operands '(0 0)))) |
---|

11 | (values |
---|

12 | (notnot (typep a 'arithmetic-error)) |
---|

13 | (notnot (typep a (find-class 'arithmetic-error))) |
---|

14 | (multiple-value-list (arithmetic-error-operation a)) |
---|

15 | (multiple-value-list (arithmetic-error-operands a)))) |
---|

16 | t t (/) ((0 0))) |
---|

17 | |
---|

18 | (deftest arithmethic-error.2 |
---|

19 | (let ((a (make-condition 'arithmetic-error |
---|

20 | :operation #'/ |
---|

21 | :operands '(0 0)))) |
---|

22 | (values |
---|

23 | (notnot (typep a 'arithmetic-error)) |
---|

24 | (notnot (typep a 'error)) |
---|

25 | (notnot (typep a 'serious-condition)) |
---|

26 | (notnot (typep a 'condition)) |
---|

27 | (notnot (typep a (find-class 'arithmetic-error))) |
---|

28 | (notnot (typep (arithmetic-error-operation a) 'function)) |
---|

29 | (funcall (arithmetic-error-operation a) 1 2) |
---|

30 | (multiple-value-list (arithmetic-error-operands a)))) |
---|

31 | t t t t t t 1/2 ((0 0))) |
---|

32 | |
---|

33 | (deftest arithmetic-error.3 |
---|

34 | (let ((a (make-condition 'arithmetic-error |
---|

35 | :operation '/ |
---|

36 | :operands '(0 0)))) |
---|

37 | (macrolet |
---|

38 | ((%m (z) z)) |
---|

39 | (values |
---|

40 | (arithmetic-error-operation (expand-in-current-env (%m a))) |
---|

41 | (arithmetic-error-operands (expand-in-current-env (%m a)))))) |
---|

42 | / (0 0)) |
---|

43 | |
---|

44 | ;;; Error tests |
---|

45 | |
---|

46 | (deftest arithmetic-error-operation.error.1 |
---|

47 | (signals-error (arithmetic-error-operation) program-error) |
---|

48 | t) |
---|

49 | |
---|

50 | (deftest arithmetic-error-operation.error.2 |
---|

51 | (signals-error (arithmetic-error-operation |
---|

52 | (make-condition 'arithmetic-error :operation '/ |
---|

53 | :operands '(1 0)) |
---|

54 | nil) |
---|

55 | program-error) |
---|

56 | t) |
---|

57 | |
---|

58 | (deftest arithmetic-error-operands.error.1 |
---|

59 | (signals-error (arithmetic-error-operands) program-error) |
---|

60 | t) |
---|

61 | |
---|

62 | (deftest arithmetic-error-operands.error.2 |
---|

63 | (signals-error (arithmetic-error-operands |
---|

64 | (make-condition 'arithmetic-error :operation '/ |
---|

65 | :operands '(1 0)) |
---|

66 | nil) |
---|

67 | program-error) |
---|

68 | t) |
---|