source: trunk/tests/ansi-tests/load.lsp @ 9045

Last change on this file since 9045 was 9045, checked in by gz, 12 years ago

Assorted cleanup:

In infrastructure:

  • add *test-verbose* and :verbose argument to do-test and do-tests. Avoid random output if false, only show failures
  • muffle-wawrnings and/or bind *suppress-compiler-warnings* in some tests that unavoidably generate them (mainly with duplicate typecase/case clauses)
  • Add record-source-file for tests so meta-. can find them
  • If *catch-errors* (or the :catch-errors arg) is :break, enter a breakloop when catch an error
  • Make test fns created by *compile-tests* have names, so can find them in backtraces
  • fix misc compiler warnings
  • Fixed cases of duplicate test numbers
  • Disable note :make-condition-with-compound-name for openmcl.

In tests themselves:

I commented out the following tests with #+bogus-test, because they just seemed wrong to me:

lambda.47
lambda.50
upgraded-array-element-type.8
upgraded-array-element-type.nil.1
pathname-match-p.5
load.17
load.18
macrolet.47
ctypecase.15

In addition, I commented out the following tests with #+bogus-test because I was too lazy to make a note
for "doesn't signal underflow":

exp.error.8 exp.error.9 exp.error.10 exp.error.11 expt.error.8 expt.error.9 expt.error.10 expt.error.11

Finally, I entered bug reports in trac, and then commented out the tests
below with #+known-bug-NNN, where nnn is the ticket number in trac:

ticket#268: encode-universal-time.3 encode-universal-time.3.1
ticket#269: macrolet.36
ticket#270: values.20 values.21
ticket#271: defclass.error.13 defclass.error.22
ticket#272: phase.10 phase.12 asin.5 asin.6 asin.8
ticket#273: phase.18 phase.19 acos.8
ticket#274: exp.error.4 exp.error.5 exp.error.6 exp.error.7
ticket#275: car.error.2 cdr.error.2
ticket#276: map.error.11
ticket#277: subtypep.cons.43
ticket#278: subtypep-function.3
ticket#279: subtypep-complex.8
ticket#280: open.output.19 open.io.19 file-position.8 file-length.4 file-length.5 read-byte.4 stream-element-type.2 stream-element-type.3
ticket#281: open.65
ticket#288: set-syntax-from-char.sharp.1

File size: 6.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Apr 12 21:51:49 2005
4;;;; Contains: Tests of LOAD
5
6(in-package :cl-test)
7
8(defun load-file-test (file funname &rest args &key
9                            if-does-not-exist
10                            (print nil print-p)
11                            (verbose nil verbose-p)
12                            (*load-print* nil)
13                            (*load-verbose* nil)
14                            external-format)
15  (declare (ignorable external-format if-does-not-exist
16                      print print-p verbose verbose-p))
17  (fmakunbound funname)
18  (let* ((str (make-array '(0) :element-type 'character :adjustable t
19                          :fill-pointer 0))
20         (vals (multiple-value-list
21                (with-output-to-string
22                  (*standard-output* str)
23                  (apply #'load file :allow-other-keys t args))))
24         (print? (if print-p print *load-print*))
25         (verbose? (if verbose-p verbose *load-verbose*)))
26      (values
27       (let ((v1 (car vals))
28             (v2 (or (and verbose-p (not verbose))
29                     (and (not verbose-p) (not *load-verbose*))
30                     (position #\; str)))
31             (v3 (or (and print-p (not print))
32                     (and (not print-p) (not *load-print*))
33                     (> (length str) 0)))
34             (v4 (if (or print? verbose?)
35                     (> (length str) 0)
36                   t)))
37         (if (and (= (length vals) 1) v1 v2 v3 v4) t (list vals v2 v3 v4 str)))
38       (funcall funname))))
39
40(deftest load.1
41  (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1)
42  t nil)
43
44(deftest load.2
45  (load-file-test #p"compile-file-test-file.lsp" 'compile-file-test-fun.1)
46  t nil)
47
48(deftest load.3
49  (with-input-from-string
50   (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)")
51   (load-file-test s 'load-file-test-fun.2))
52  t good)
53
54(deftest load.4
55  (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
56                  :external-format :default)
57  t nil)
58
59(deftest load.5
60  (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
61                  :verbose t)
62  t nil)
63
64(deftest load.6
65  (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
66                  :*load-verbose* t)
67  t nil)
68
69(deftest load.7
70  (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
71                  :*load-verbose* t :verbose nil)
72  t nil)
73
74(deftest load.8
75  (with-input-from-string
76   (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)")
77   (load-file-test s 'load-file-test-fun.2 :verbose t))
78  t good)
79
80(deftest load.9
81  (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
82                  :print t)
83  t nil)
84
85(deftest load.10
86  (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
87                  :*load-print* t)
88  t nil)
89
90(deftest load.11
91  (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
92                  :*load-print* t :print nil)
93  t nil)
94
95(deftest load.12
96  (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
97                  :*load-print* nil :print t)
98  t nil)
99
100(deftest load.13
101  (with-input-from-string
102   (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)")
103   (load-file-test s 'load-file-test-fun.2 :print t))
104  t good)
105
106(deftest load.14
107  (load "nonexistent-file.lsp" :if-does-not-exist nil)
108  nil)
109
110(defpackage LOAD-TEST-PACKAGE (:use "COMMON-LISP"))
111
112(deftest load.15
113  (let ((*package* (find-package "LOAD-TEST-PACKAGE")))
114    (with-input-from-string
115     (s "(defun f () 'good)")
116     (load-file-test s 'load-test-package::f)))
117  t load-test-package::good)
118
119(deftest load.15a
120  (let ((*package* (find-package "CL-TEST")))
121    (values
122     (with-input-from-string
123      (s "(eval-when (:load-toplevel :execute) (setq *package* (find-package \"LOAD-TEST-PACKAGE\")))
124          (defun f () 'good)")
125      (multiple-value-list (load-file-test s 'load-test-package::f)))
126     (read-from-string "GOOD")))
127  (t load-test-package::good) good)
128
129(deftest load.16
130  (let ((*readtable* (copy-readtable nil)))
131    (set-macro-character #\! (get-macro-character #\'))
132    (with-input-from-string
133     (s "(in-package :cl-test) (defun load-file-test-fun.3 () !good)")
134     (load-file-test s 'load-file-test-fun.3)))
135  t good)
136
137(deftest load.16a
138  (let ((*readtable* *readtable*)
139        (*package* (find-package "CL-TEST")))
140    (values
141     (with-input-from-string
142      (s "(in-package :cl-test)
143         (eval-when (:load-toplevel :execute)
144            (setq *readtable* (copy-readtable nil))
145            (set-macro-character #\\! (get-macro-character #\\')))
146         (defun load-file-test-fun.3 () !good)")
147      (multiple-value-list
148       (load-file-test s 'load-file-test-fun.3)))
149     (read-from-string "!FOO")))
150  (t good) !FOO)
151
152(deftest load.17
153  (let ((file #p"load-test-file.lsp"))
154    (fmakunbound 'load-file-test-fun.1)
155    (fmakunbound 'load-file-test-fun.2)
156    (values
157     (notnot (load file))
158     #+bogus-test
159     (let ((p1 (pathname (merge-pathnames file)))
160           (p2 (funcall 'load-file-test-fun.1)))
161       (equalpt-or-report p1 p2))
162     (let ((p1 (truename file))
163           (p2 (funcall 'load-file-test-fun.2)))
164       (equalpt-or-report p1 p2))))
165  t #+bogus-test t t)
166
167;;; Test that the load pathname/truename variables are bound
168;;; properly when loading compiled files
169
170(deftest load.18
171  (let* ((file "load-test-file-2.lsp")
172         (target (enough-namestring (compile-file-pathname file))))
173    (declare (special *load-test-var.1* *load-test-var.2*))
174    (compile-file file)
175    (makunbound '*load-test-var.1*)
176    (makunbound '*load-test-var.2*)
177    (load target)
178    (values
179     #+bogus-test
180     (let ((p1 (pathname (merge-pathnames target)))
181           (p2 *load-test-var.1*))
182       (equalpt-or-report p1 p2))
183     (let ((p1 (truename target))
184           (p2 *load-test-var.2*))
185       (equalpt-or-report p1 p2))))
186  #+bogus-test t t)
187
188(deftest load.19
189  (let ((file (logical-pathname "CLTEST:LDTEST.LSP"))
190        (fn 'load-test-fun-3)
191        (*package* (find-package "CL-TEST")))
192    (with-open-file
193     (s file :direction :output :if-exists :supersede
194        :if-does-not-exist :create)
195     (format s "(in-package :cl-test) (defun ~a () :foo)" fn))
196    (fmakunbound fn)
197    (values
198     (notnot (load file))
199     (funcall fn)))
200  t :foo)
201
202;;; Defaults of the load variables
203
204(deftest load-pathname.1
205  *load-pathname*
206  nil)
207
208(deftest load-truename.1
209  *load-truename*
210  nil)
211
212(deftest load-print.1
213  *load-print*
214  nil)
215
216;;; Error tests
217
218(deftest load.error.1
219  (signals-error (load "nonexistent-file.lsp") file-error)
220  t)
221
222(deftest load.error.2
223  (signals-error (load) program-error)
224  t)
225
226(deftest load.error.3
227  (signals-error (load "compile-file-test-file.lsp" :bad-key-arg t)
228                 program-error)
229  t)
Note: See TracBrowser for help on using the repository browser.