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

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

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

File size: 6.2 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     (let ((p1 (pathname (merge-pathnames file)))
159           (p2 (funcall 'load-file-test-fun.1)))
160       (equalpt-or-report p1 p2))
161     (let ((p1 (truename file))
162           (p2 (funcall 'load-file-test-fun.2)))
163       (equalpt-or-report p1 p2))))
164  t t t)
165
166;;; Test that the load pathname/truename variables are bound
167;;; properly when loading compiled files
168
169(deftest load.18
170  (let* ((file "load-test-file-2.lsp")
171         (target (enough-namestring (compile-file-pathname file))))
172    (declare (special *load-test-var.1* *load-test-var.2*))
173    (compile-file file)
174    (makunbound '*load-test-var.1*)
175    (makunbound '*load-test-var.2*)
176    (load target)
177    (values
178     (let ((p1 (pathname (merge-pathnames target)))
179           (p2 *load-test-var.1*))
180       (equalpt-or-report p1 p2))
181     (let ((p1 (truename target))
182           (p2 *load-test-var.2*))
183       (equalpt-or-report p1 p2))))
184  t t)
185
186(deftest load.19
187  (let ((file (logical-pathname "CLTEST:LDTEST.LSP"))
188        (fn 'load-test-fun-3)
189        (*package* (find-package "CL-TEST")))
190    (with-open-file
191     (s file :direction :output :if-exists :supersede
192        :if-does-not-exist :create)
193     (format s "(in-package :cl-test) (defun ~a () :foo)" fn))
194    (fmakunbound fn)
195    (values
196     (notnot (load file))
197     (funcall fn)))
198  t :foo)
199
200;;; Defaults of the load variables
201
202(deftest load-pathname.1
203  *load-pathname*
204  nil)
205
206(deftest load-truename.1
207  *load-truename*
208  nil)
209
210(deftest load-print.1
211  *load-print*
212  nil)
213
214;;; Error tests
215
216(deftest load.error.1
217  (signals-error (load "nonexistent-file.lsp") file-error)
218  t)
219
220(deftest load.error.2
221  (signals-error (load) program-error)
222  t)
223
224(deftest load.error.3
225  (signals-error (load "compile-file-test-file.lsp" :bad-key-arg t)
226                 program-error)
227  t)
Note: See TracBrowser for help on using the repository browser.