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

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

3 | ;;;; Created: Sat Oct 19 06:48:02 2002 |
---|

4 | ;;;; Contains: Tests for MULTIPLE-VALUE-PROG1 |
---|

5 | |
---|

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

7 | |
---|

8 | (deftest multiple-value-prog1.1 |
---|

9 | (multiple-value-prog1 nil) |
---|

10 | nil) |
---|

11 | |
---|

12 | (deftest multiple-value-prog1.2 |
---|

13 | (multiple-value-prog1 '(a b c)) |
---|

14 | (a b c)) |
---|

15 | |
---|

16 | (deftest multiple-value-prog1.3 |
---|

17 | (multiple-value-prog1 (values-list '(a b c))) |
---|

18 | a b c) |
---|

19 | |
---|

20 | (deftest multiple-value-prog1.4 |
---|

21 | (multiple-value-prog1 (values))) |
---|

22 | |
---|

23 | (deftest multiple-value-prog1.5 |
---|

24 | (let ((x 0) (y 0)) |
---|

25 | (multiple-value-prog1 (values x y) |
---|

26 | (incf x) (incf y 2))) |
---|

27 | 0 0) |
---|

28 | |
---|

29 | (deftest multiple-value-prog1.6 |
---|

30 | (let ((x 0) (y 0)) |
---|

31 | (multiple-value-call |
---|

32 | #'list |
---|

33 | (multiple-value-prog1 (values x y) |
---|

34 | (incf x) (incf y 2)) |
---|

35 | x y)) |
---|

36 | (0 0 1 2)) |
---|

37 | |
---|

38 | (deftest multiple-value-prog1.7 |
---|

39 | (let ((x 0) (y 0)) |
---|

40 | (multiple-value-call |
---|

41 | #'list |
---|

42 | (multiple-value-prog1 (values (incf x) y) |
---|

43 | (incf x x) |
---|

44 | (incf y 10)) |
---|

45 | x y)) |
---|

46 | (1 0 2 10)) |
---|

47 | |
---|

48 | |
---|

49 | (deftest multiple-value-prog1.8 |
---|

50 | (let* ((n (min 100 multiple-values-limit))) |
---|

51 | (not-mv |
---|

52 | (loop for i from 0 below n |
---|

53 | for x = (make-int-list i) |
---|

54 | always |
---|

55 | (equalt |
---|

56 | (multiple-value-list |
---|

57 | (eval `(multiple-value-prog1 (values-list (quote ,(copy-seq x))) |
---|

58 | nil))) |
---|

59 | x)))) |
---|

60 | nil) |
---|

61 | |
---|

62 | |
---|

63 | (deftest multiple-value-prog1.9 |
---|

64 | (let ((x 0) (y 0)) |
---|

65 | (values |
---|

66 | (block foo |
---|

67 | (multiple-value-prog1 |
---|

68 | (values (incf x) (incf y 2)) |
---|

69 | (return-from foo 'a))) |
---|

70 | x y)) |
---|

71 | a 1 2) |
---|

72 | |
---|

73 | ;;; No implicit tagbody |
---|

74 | (deftest multiple-value-prog1.10 |
---|

75 | (block nil |
---|

76 | (tagbody |
---|

77 | (multiple-value-prog1 |
---|

78 | (values) |
---|

79 | (go 10) |
---|

80 | 10 |
---|

81 | (return 'bad)) |
---|

82 | 10 |
---|

83 | (return 'good))) |
---|

84 | good) |
---|

85 | |
---|

86 | ;;; Macros are expanded in the appropriate environment |
---|

87 | |
---|

88 | (deftest multiple-value-prog1.11 |
---|

89 | (macrolet |
---|

90 | ((%m (z) z)) |
---|

91 | (multiple-value-prog1 (expand-in-current-env (%m :good)))) |
---|

92 | :good) |
---|

93 | |
---|

94 | (deftest multiple-value-prog1.12 |
---|

95 | (macrolet |
---|

96 | ((%m (z) z)) |
---|

97 | (multiple-value-prog1 :good (expand-in-current-env (%m :foo)))) |
---|

98 | :good) |
---|