source: trunk/abcl/test/lisp/abcl/jar-file.lisp @ 12424

Last change on this file since 12424 was 12424, checked in by Mark Evenson, 12 years ago

Further tests for jar pathnames.

jar-file.lisp now has network based FASL loads.

Additional associated Java unit tests.

File size: 10.0 KB
Line 
1(in-package #:abcl.test.lisp)
2
3(defvar *jar-file-init* nil)
4
5;;; From CL-FAD
6(defvar *stream-buffer-size* 8192)
7(defun cl-fad-copy-stream (from to &optional (checkp t))
8  "Copies into TO \(a stream) from FROM \(also a stream) until the end
9of FROM is reached, in blocks of *stream-buffer-size*.  The streams
10should have the same element type.  If CHECKP is true, the streams are
11checked for compatibility of their types."
12  (when checkp
13    (unless (subtypep (stream-element-type to) (stream-element-type from))
14      (error "Incompatible streams ~A and ~A." from to)))
15  (let ((buf (make-array *stream-buffer-size*
16                         :element-type (stream-element-type from))))
17    (loop
18     (let ((pos (read-sequence buf from)))
19       (when (zerop pos) (return))
20       (write-sequence buf to :end pos))))
21  (values))
22
23(defun cl-fad-copy-file (from to &key overwrite)
24  "Copies the file designated by the non-wild pathname designator FROM
25to the file designated by the non-wild pathname designator TO.  If
26OVERWRITE is true overwrites the file designtated by TO if it exists."
27  (let ((element-type '(unsigned-byte 8)))
28    (with-open-file (in from :element-type element-type)
29      (with-open-file (out to :element-type element-type
30                              :direction :output
31                              :if-exists (if overwrite
32                                           :supersede :error))
33        (cl-fad-copy-stream in out))))
34  (values))
35
36(defun jar-file-init ()
37  (let* ((*default-pathname-defaults*  *abcl-test-directory*)
38         (asdf::*verbose-out* *standard-output*))
39    (compile-file "foo.lisp")
40    (compile-file "bar.lisp")
41    (compile-file "eek.lisp")
42    (let* ((dir (merge-pathnames "tmp/" *abcl-test-directory*))
43           (sub (merge-pathnames "a/b/" dir)))
44      (when (probe-directory dir)
45        (delete-directory-and-files dir))
46      (ensure-directories-exist sub)
47      (sys:unzip (merge-pathnames "foo.abcl")
48                 dir)
49      (sys:unzip (merge-pathnames "foo.abcl")
50                 sub)
51      (cl-fad-copy-file (merge-pathnames "bar.abcl")
52                 (merge-pathnames "bar.abcl" dir))
53      (cl-fad-copy-file (merge-pathnames "bar.abcl")
54                 (merge-pathnames "bar.abcl" sub))
55      (cl-fad-copy-file (merge-pathnames "eek.lisp")
56                 (merge-pathnames "eek.lisp" dir))
57      (cl-fad-copy-file (merge-pathnames "eek.lisp")
58                 (merge-pathnames "eek.lisp" sub))
59      (sys:zip (merge-pathnames "baz.jar")
60               (append
61                (directory (merge-pathnames "*" dir))
62                (directory (merge-pathnames "*" sub)))
63               dir)
64      (delete-directory-and-files dir)))
65  (setf *jar-file-init* t))
66
67(defmacro with-jar-file-init (&rest body)
68  `(let ((*default-pathname-defaults* *abcl-test-directory*))
69     (progn
70       (unless *jar-file-init*
71         (jar-file-init))
72       ,@body)))
73
74#+nil
75(defmacro with-jar-file-init (&rest body)
76  `(progv '(*default-pathname-defaults*) '(,*abcl-test-directory*)
77    (unless *jar-file-init*
78      (load-init))
79    ,@body))
80
81(deftest jar-file.load.1
82    (with-jar-file-init
83      (load "jar:file:baz.jar!/foo"))
84  t)
85
86(deftest jar-file.load.2
87    (with-jar-file-init
88      (load "jar:file:baz.jar!/bar"))
89  t)
90
91(deftest jar-file.load.3
92    (with-jar-file-init
93      (load "jar:file:baz.jar!/bar.abcl"))
94  t)
95
96(deftest jar-file.load.4
97    (with-jar-file-init
98      (load "jar:file:baz.jar!/eek"))
99  t)
100
101(deftest jar-file.load.5
102    (with-jar-file-init
103      (load "jar:file:baz.jar!/eek.lisp"))
104  t)
105
106(deftest jar-file.load.6
107    (with-jar-file-init
108      (load "jar:file:baz.jar!/a/b/foo"))
109  t)
110
111(deftest jar-file.load.7
112    (with-jar-file-init
113      (load "jar:file:baz.jar!/a/b/bar"))
114  t)
115
116(deftest jar-file.load.8
117    (with-jar-file-init
118      (load "jar:file:baz.jar!/a/b/bar.abcl"))
119  t)
120
121(deftest jar-file.load.9
122    (with-jar-file-init
123      (load "jar:file:baz.jar!/a/b/eek"))
124  t)
125
126(deftest jar-file.load.10
127    (with-jar-file-init
128      (load "jar:file:baz.jar!/a/b/eek.lisp"))
129  t)
130
131;;; wrapped in PROGN for easy disabling without a network connection
132;;; XXX come up with a better abstraction
133(progn 
134  (deftest jar-file.load.11
135      (load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/foo")
136    t)
137
138  (deftest jar-file.load.12
139      (load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/bar")
140    t)
141
142  (deftest jar-file.load.13
143      (load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/bar.abcl")
144    t)
145
146  (deftest jar-file.load.14
147      (load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/eek")
148    t)
149
150  (deftest jar-file.load.15
151      (load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/eek.lisp")
152    t)
153
154  (deftest jar-file.load.16
155      (load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/a/b/foo")
156    t)
157
158  (deftest jar-file.load.17
159      (load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/a/b/bar")
160    t)
161
162  (deftest jar-file.load.18
163      (load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/a/b/bar.abcl")
164    t)
165
166  (deftest jar-file.load.19
167      (load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/a/b/eek")
168    t)
169
170  (deftest jar-file.load.20
171      (load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/a/b/eek.lisp")
172    t))
173
174
175(deftest jar-file.probe-file.1
176    (with-jar-file-init
177        (probe-file "jar:file:baz.jar!/eek.lisp"))
178  #p#.(format nil "jar:file:~A/baz.jar!/eek.lisp" 
179              (namestring *abcl-test-directory*)))
180
181(deftest jar-file.probe-file.2
182    (with-jar-file-init
183        (probe-file "jar:file:baz.jar!/a/b/bar.abcl"))
184  #p#.(format nil "jar:file:~A/baz.jar!/a/b/bar.abcl"
185              (namestring *abcl-test-directory*)))
186
187(deftest jar-file.probe-file.3
188    (with-jar-file-init
189        (probe-file "jar:jar:file:baz.jar!/a/b/bar.abcl!/bar._"))
190   #p#.(format nil "jar:jar:file:~Abaz.jar!/a/b/bar.abcl!/bar._"
191                       (namestring *abcl-test-directory*)))
192
193(deftest jar-file.probe-file.4
194    (with-jar-file-init
195        (probe-file "jar:file:baz.jar!/a/b"))
196  nil)
197
198(deftest jar-file.probe-file.5
199    (with-jar-file-init
200        (probe-file "jar:file:baz.jar!/a/b/"))
201  #p#.(format nil "jar:file:~Abaz.jar!/a/b/"
202                       (namestring *abcl-test-directory*)))
203
204(deftest jar-file.merge-pathnames.1
205    (merge-pathnames 
206     "/bar.abcl" #p"jar:file:baz.jar!/foo")
207  #p"jar:file:baz.jar!/bar.abcl")
208
209(deftest jar-file.merge-pathnames.2
210    (merge-pathnames 
211     "bar.abcl" #p"jar:file:baz.jar!/foo/")
212  #p"jar:file:baz.jar!/foo/bar.abcl")
213
214(deftest jar-file.merge-pathnames.3
215    (merge-pathnames 
216     "jar:file:baz.jar!/foo" "bar")
217  #p"jar:file:baz.jar!/foo")
218
219(deftest jar-file.merge-pathnames.4
220    (merge-pathnames 
221     "jar:file:baz.jar!/foo" "/a/b/c")
222  #p"jar:file:/a/b/baz.jar!/foo")
223
224(deftest jar-file.truename.1
225    (signals-error (truename "jar:file:baz.jar!/foo")
226                   'file-error)
227  t)
228
229
230(deftest jar-file.pathname.1
231    (let* ((p #p"jar:file:foo/baz.jar!/")
232           (d (first (pathname-device p))))
233      (values
234       (pathname-directory d) (pathname-name d) (pathname-type d)))
235  (:relative "foo") "baz" "jar")
236
237(deftest jar-file.pathname.2
238    (let* ((p #p"jar:file:baz.jar!/foo.abcl")
239           (d (first (pathname-device p))))
240      (values
241       (pathname-name d) (pathname-type d) 
242       (pathname-directory p) (pathname-name p) (pathname-type p)))
243  "baz" "jar"
244   nil "foo" "abcl")
245   
246(deftest jar-file.pathname.3
247    (let* ((p #p"jar:jar:file:baz.jar!/foo.abcl!/")
248           (d0 (first (pathname-device p)))
249           (d1 (second (pathname-device p))))
250      (values 
251       (pathname-name d0) (pathname-type d0)
252       (pathname-name d1) (pathname-type d1)))
253  "baz" "jar"
254  "foo" "abcl")
255
256(deftest jar-file.pathname.4
257    (let* ((p #p"jar:jar:file:a/baz.jar!/b/c/foo.abcl!/this/that/foo-20.cls")
258           (d0 (first (pathname-device p)))
259           (d1 (second (pathname-device p))))
260      (values 
261       (pathname-directory d0) (pathname-name d0) (pathname-type d0)
262       (pathname-directory d1) (pathname-name d1) (pathname-type d1)
263       (pathname-directory p) (pathname-name p) (pathname-type p)))
264  (:relative "a") "baz" "jar"
265  (:relative "b" "c") "foo" "abcl"
266  (:relative "this" "that") "foo-20" "cls")
267
268(deftest jar-file.pathname.5
269    (let* ((p #p"jar:jar:file:a/foo/baz.jar!/b/c/foo.abcl!/armed/bear/bar-1.cls")
270           (d0 (first (pathname-device p)))
271           (d1 (second (pathname-device p))))
272      (values 
273       (pathname-directory d0) (pathname-name d0) (pathname-type d0)
274       (pathname-directory d1) (pathname-name d1) (pathname-type d1)
275       (pathname-directory p) (pathname-name p) (pathname-type p)))
276  (:relative "a" "foo" ) "baz" "jar"
277  (:relative "b" "c") "foo" "abcl"
278  (:relative "armed" "bear") "bar-1" "cls")
279
280(deftest jar-file.pathname.6
281    (let* ((p #p"jar:http://example.org/abcl.jar!/org/armedbear/lisp/Version.class")
282           (d (first (pathname-device p))))
283
284      (values 
285       d
286       (pathname-directory p) (pathname-name p) (pathname-type p)))
287  "http://example.org/abcl.jar" 
288  (:relative "org" "armedbear" "lisp") "Version" "class")
289
290(deftest jar-file.pathname.7
291    (let* ((p #p"jar:jar:http://example.org/abcl.jar!/foo.abcl!/foo-1.cls")
292           (d (pathname-device p))
293           (d0 (first d))
294           (d1 (second d)))
295      (values
296       d0 
297       (pathname-name d1) (pathname-type d1)
298       (pathname-name p) (pathname-type p)))
299  "http://example.org/abcl.jar"
300  "foo" "abcl"
301  "foo-1" "cls")
302
303(deftest jar-file.pathname.8
304    (let* ((p #p"jar:file:/a/b/foo.jar!/")
305           (d (first (pathname-device p))))
306      (values
307       (pathname-directory d) (pathname-name d) (pathname-type d)))
308  (:ABSOLUTE "a" "b") "foo" "jar")
309
310(deftest jar-file.pathname.9
311    (let* ((p #p"jar:file:a/b/foo.jar!/c/d/foo.lisp")
312           (d (first (pathname-device p))))
313      (values
314       (pathname-directory d) (pathname-name d) (pathname-type d)
315       (pathname-directory p) (pathname-name p) (pathname-type p)))
316  (:RELATIVE "a" "b") "foo" "jar"
317  (:RELATIVE "c" "d") "foo" "lisp")
318
319     
320     
321             
322
323       
324       
325
326 
Note: See TracBrowser for help on using the repository browser.