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

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

3 | ;;;; Created: Sat Feb 15 20:12:04 2003 |
---|

4 | ;;;; Contains: Tests of CHECK-TYPE |
---|

5 | |
---|

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

7 | |
---|

8 | (deftest check-type.1 |
---|

9 | (let ((x 'a)) |
---|

10 | (values (check-type x symbol) x)) |
---|

11 | nil a) |
---|

12 | |
---|

13 | (deftest check-type.2 |
---|

14 | (signals-type-error x 'a (check-type x integer)) |
---|

15 | t) |
---|

16 | |
---|

17 | (deftest check-type.3 |
---|

18 | (let ((x 'a)) |
---|

19 | (handler-bind |
---|

20 | ((type-error #'(lambda (c) |
---|

21 | (assert (eql (type-error-datum c) x)) |
---|

22 | (assert (not (typep x (type-error-expected-type c)))) |
---|

23 | ;; Can we assume the expected-type is NUMBER? |
---|

24 | (store-value 15 c)))) |
---|

25 | (values (check-type x number) x))) |
---|

26 | nil 15) |
---|

27 | |
---|

28 | (deftest check-type.4 |
---|

29 | (let ((x 'a)) |
---|

30 | (values (check-type x symbol "a symbol") x)) |
---|

31 | nil a) |
---|

32 | |
---|

33 | (deftest check-type.5 |
---|

34 | (let ((x 'a)) |
---|

35 | (handler-bind |
---|

36 | ((type-error #'(lambda (c) |
---|

37 | (assert (eql (type-error-datum c) x)) |
---|

38 | (assert (not (typep x (type-error-expected-type c)))) |
---|

39 | ;; Can we assume the expected-type is STRING? |
---|

40 | (store-value "abc" c)))) |
---|

41 | (values (check-type x string "a string") x))) |
---|

42 | nil "abc") |
---|

43 | |
---|

44 | (deftest check-type.6 |
---|

45 | (let ((x 'a)) |
---|

46 | (handler-bind |
---|

47 | ((type-error #'(lambda (c) |
---|

48 | (assert (eql (type-error-datum c) x)) |
---|

49 | (assert (not (typep x (type-error-expected-type c)))) |
---|

50 | ;; Can we assume the expected-type is NUMBER? |
---|

51 | (store-value 15 nil)))) |
---|

52 | (values (check-type x number) x))) |
---|

53 | nil 15) |
---|

54 | |
---|

55 | (deftest check-type.7 |
---|

56 | (let ((x 'a)) |
---|

57 | (handler-bind |
---|

58 | ((type-error #'(lambda (c) |
---|

59 | (assert (eql (type-error-datum c) x)) |
---|

60 | (assert (not (typep x (type-error-expected-type c)))) |
---|

61 | ;; Can we assume the expected-type is NUMBER? |
---|

62 | (store-value 15)))) |
---|

63 | (values (check-type x number) x))) |
---|

64 | nil 15) |
---|

65 | |
---|

66 | ;;; Test that explicit calls to macroexpand in subforms |
---|

67 | ;;; are done in the correct environment |
---|

68 | |
---|

69 | (deftest check-type.8 |
---|

70 | (let ((x 10)) |
---|

71 | (macrolet |
---|

72 | ((%m (z) z)) |
---|

73 | (check-type (expand-in-current-env (%m x)) |
---|

74 | (integer 8 13)))) |
---|

75 | nil) |
---|

76 | |
---|

77 | (deftest check-type.9 |
---|

78 | (let ((x 10)) |
---|

79 | (macrolet |
---|

80 | ((%m (z) z)) |
---|

81 | (check-type x (integer 9 12) (expand-in-current-env (%m "Foo!"))))) |
---|

82 | nil) |
---|

83 | |
---|