source: trunk/source/tests/ansi-tests/multiple-value-prog1.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 2.0 KB
Line 
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)
Note: See TracBrowser for help on using the repository browser.