source: trunk/source/tests/ansi-tests/eval-when.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: 3.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Apr  6 17:00:30 2003
4;;;; Contains: Tests for EVAL-WHEN
5
6;;; The following test was suggested by Sam Steingold,
7;;; so I've created this file to hold it.
8
9(in-package :cl-test)
10
11(defvar *eval-when.1-collector*)
12
13(deftest eval-when.1
14 
15  (let ((forms nil) all (ff "generated-eval-when-test-file.lisp"))
16    (dolist (c '(nil (:compile-toplevel)))
17      (dolist (l '(nil (:load-toplevel)))
18        (dolist (x '(nil (:execute)))
19          (push `(eval-when (,@c ,@l ,@x)
20                   (push '(,@c ,@l ,@x) *eval-when.1-collector*))
21                forms))))
22    (dolist (c '(nil (:compile-toplevel)))
23      (dolist (l '(nil (:load-toplevel)))
24        (dolist (x '(nil (:execute)))
25          (push `(let () (eval-when (,@c ,@l ,@x)
26                           (push '(let ,@c ,@l ,@x) *eval-when.1-collector*)))
27                forms))))
28    (with-open-file (o ff :direction :output :if-exists :supersede)
29                    (dolist (f forms)
30                      (prin1 f o)
31                      (terpri o)))
32    (let ((*eval-when.1-collector* nil))
33      (load ff)
34      (push (cons "load source" *eval-when.1-collector*) all))
35    (let ((*eval-when.1-collector* nil))
36      (compile-file ff)
37      (push (cons "compile source" *eval-when.1-collector*) all))
38    (let ((*eval-when.1-collector* nil))
39      (load (compile-file-pathname ff))
40      (push (cons "load compiled" *eval-when.1-collector*) all))
41    (delete-file ff)
42    (delete-file (compile-file-pathname ff))
43    #+clisp (delete-file (make-pathname :type "lib" :defaults ff))
44    (nreverse all))
45 
46  (("load source"
47    (:execute) (:load-toplevel :execute) (:compile-toplevel :execute)
48    (:compile-toplevel :load-toplevel :execute)
49    (let :execute) (let :load-toplevel :execute)
50    (let :compile-toplevel :execute)
51    (let :compile-toplevel :load-toplevel :execute))
52   ("compile source"
53    (:compile-toplevel) (:compile-toplevel :execute)
54    (:compile-toplevel :load-toplevel)
55    (:compile-toplevel :load-toplevel :execute))
56   ("load compiled"
57    (:load-toplevel) (:load-toplevel :execute)
58    (:compile-toplevel :load-toplevel)
59    (:compile-toplevel :load-toplevel :execute)
60    (let :execute) (let :load-toplevel :execute)
61    (let :compile-toplevel :execute)
62    (let :compile-toplevel :load-toplevel :execute))))
63
64;;; More EVAL-WHEN tests to go here
65
66(deftest eval-when.2
67  (eval-when () :bad)
68  nil)
69
70(deftest eval-when.3
71  (eval-when (:execute))
72  nil)
73
74(deftest eval-when.4
75  (eval-when (:execute) :good)
76  :good)
77
78(deftest eval-when.5
79  (eval-when (:compile-toplevel) :bad)
80  nil)
81
82(deftest eval-when.6
83  (eval-when (:load-toplevel) :bad)
84  nil)
85
86(deftest eval-when.7
87  (eval-when (:compile-toplevel :execute) :good)
88  :good)
89
90(deftest eval-when.8
91  (eval-when (:load-toplevel :execute) :good)
92  :good)
93
94(deftest eval-when.9
95  (eval-when (:load-toplevel :compile-toplevel) :bad)
96  nil)
97
98(deftest eval-when.10
99  (eval-when (:load-toplevel :compile-toplevel :execute) :good)
100  :good)
101
102(deftest eval-when.11
103  (eval-when (:execute) (values 'a 'b 'c 'd))
104  a b c d)
105
106(deftest eval-when.12
107  (let ((x :good))
108    (values (eval-when (:load-toplevel) (setq x :bad)) x))
109  nil :good)
110
111(deftest eval-when.13
112  (let ((x :good))
113    (values (eval-when (:compile-toplevel) (setq x :bad)) x))
114  nil :good)
115
116(deftest eval-when.14
117  (let ((x :bad))
118    (values (eval-when (:execute) (setq x :good)) x))
119  :good :good)
120
121(deftest eval-when.15
122  (let ((x :good))
123    (values (eval-when (load) (setq x :bad)) x))
124  nil :good)
125
126(deftest eval-when.16
127  (let ((x :good))
128    (values (eval-when (compile) (setq x :bad)) x))
129  nil :good)
130
131(deftest eval-when.17
132  (let ((x :bad))
133    (values (eval-when (eval) (setq x :good)) x))
134  :good :good)
135
136;;; Macros are expanded in the appropriate environment
137
138(deftest eval-when.18
139  (macrolet ((%m (z) z))
140            (eval-when (:execute) (expand-in-current-env (%m :good))))
141  :good)
Note: See TracBrowser for help on using the repository browser.