source: trunk/abcl/test/lisp/abcl/jar-pathname.lisp @ 13323

Last change on this file since 13323 was 13323, checked in by Mark Evenson, 10 years ago

Update remote jar for pathname tests.

An incompatible FASL format prevented the tests from working.

File size: 12.3 KB
Line 
1(in-package #:abcl.test.lisp)
2
3(defvar *jar-file-init* nil)
4
5(defparameter *tmp-directory* nil)
6
7(eval-when (:compile-toplevel :load-toplevel)
8  (let ((temp-file (java:jcall "getAbsolutePath" 
9                               (java:jstatic "createTempFile" "java.io.File" "jar" "tmp"))))
10    (setf *tmp-directory*
11          (make-pathname :directory 
12                         (append 
13                          (pathname-directory (pathname temp-file))
14                          '("jar-pathname-tests"))))))
15
16(defvar *foo.lisp*
17  `((defun foo ()
18      (labels ((output ()
19                 (format t "FOO here.")))
20        (output)))))
21
22(defvar *bar.lisp*
23  `((defvar *pathname* *load-pathname*)
24    (defvar *truename* *load-truename*)
25
26    (defun bar () 
27      (labels 
28          ((output () 
29             (format t "Some BAR~%*load-pathname* ~S~%*load-truename* ~S~%"
30                     *pathname* *truename*)))
31        (output)))
32    (defvar *bar* t)
33
34    (defun baz ()
35      (format t "Some BAZ"))))
36
37(defvar *eek.lisp* 
38  `((defun eek ()
39      (format t "Another EEK."))
40    (defun ook ()
41      (let ((*load-verbose* t))
42        (load (merge-pathnames #p"bar" *load-truename*))))
43    (defun aak ()
44      (format t "*LOAD-TRUENAME* is '~A'" *load-truename*))))
45
46(defun write-forms (forms path)
47  (with-open-file (s path :direction :output :if-exists :supersede)
48    (with-standard-io-syntax
49      (dolist (form forms)
50        (print form s)))))
51
52(defun jar-file-init ()
53  (format t "~&Using ~A to create files for testing jar-pathnames.~%" *tmp-directory*)
54  (ensure-directories-exist *tmp-directory*)
55  (let* ((*default-pathname-defaults*  *tmp-directory*)
56         (asdf::*verbose-out* *standard-output*))
57    (write-forms *foo.lisp* "foo.lisp")
58    (compile-file "foo.lisp")
59    (write-forms *bar.lisp* "bar.lisp")
60    (compile-file "bar.lisp")
61    (write-forms *eek.lisp* "eek.lisp")
62    (compile-file "eek.lisp")
63    (let* ((tmpdir (merge-pathnames "tmp/" *tmp-directory*))
64           (subdirs 
65            (mapcar (lambda (p) (merge-pathnames p tmpdir))
66                    '("a/b/" "d/e+f/")))
67           (sub1 (first subdirs))
68           (sub2 (second subdirs)))
69      (when (probe-directory tmpdir)
70        (delete-directory-and-files tmpdir))
71      (mapcar (lambda (p) (ensure-directories-exist p)) subdirs)
72      (sys:unzip (merge-pathnames "foo.abcl") tmpdir)
73      (sys:unzip (merge-pathnames "foo.abcl") sub1)
74      (cl-fad-copy-file (merge-pathnames "bar.abcl")
75                        (merge-pathnames "bar.abcl" tmpdir))
76      (cl-fad-copy-file (merge-pathnames "bar.abcl")
77                        (merge-pathnames "bar.abcl" sub1))
78      (cl-fad-copy-file (merge-pathnames "bar.abcl")
79                        (merge-pathnames "bar.abcl" sub2))
80      (cl-fad-copy-file (merge-pathnames "eek.lisp")
81                        (merge-pathnames "eek.lisp" tmpdir))
82      (cl-fad-copy-file (merge-pathnames "eek.lisp")
83                        (merge-pathnames "eek.lisp" sub1))
84      (sys:zip (merge-pathnames "baz.jar")
85               (loop :for p :in (list tmpdir sub1 sub2)
86                  :appending (directory (merge-pathnames "*" p)))
87               tmpdir)
88      #+nil (delete-directory-and-files dir)))
89  (setf *jar-file-init* t))
90
91(defmacro with-jar-file-init (&rest body)
92  `(let ((*default-pathname-defaults* *tmp-directory*))
93     (progn
94       (unless *jar-file-init*
95         (jar-file-init))
96       ,@body)))
97
98(deftest jar-pathname.load.1
99    (with-jar-file-init
100      (load "jar:file:baz.jar!/foo"))
101  t)
102
103(deftest jar-pathname.load.2
104    (with-jar-file-init
105      (load "jar:file:baz.jar!/bar"))
106  t)
107
108(deftest jar-pathname.load.3
109    (with-jar-file-init
110      (load "jar:file:baz.jar!/bar.abcl"))
111  t)
112
113(deftest jar-pathname.load.4
114    (with-jar-file-init
115      (load "jar:file:baz.jar!/eek"))
116  t)
117
118(deftest jar-pathname.load.5
119    (with-jar-file-init
120      (load "jar:file:baz.jar!/eek.lisp"))
121  t)
122
123(deftest jar-pathname.load.6
124    (with-jar-file-init
125      (load "jar:file:baz.jar!/a/b/foo"))
126  t)
127
128(deftest jar-pathname.load.7
129    (with-jar-file-init
130      (load "jar:file:baz.jar!/a/b/bar"))
131  t)
132
133(deftest jar-pathname.load.8
134    (with-jar-file-init
135      (load "jar:file:baz.jar!/a/b/bar.abcl"))
136  t)
137
138(deftest jar-pathname.load.9
139    (with-jar-file-init
140      (load "jar:file:baz.jar!/a/b/eek"))
141  t)
142
143(deftest jar-pathname.load.10
144    (with-jar-file-init
145      (load "jar:file:baz.jar!/a/b/eek.lisp"))
146  t)
147
148(deftest jar-pathname.load.11
149    (with-jar-file-init
150        (load "jar:file:baz.jar!/d/e+f/bar.abcl"))
151  t)
152
153;;; wrapped in PROGN for easy disabling without a network connection
154;;; XXX come up with a better abstraction
155
156(defvar *url-jar-pathname-base*
157  "jar:http://abcl-dynamic-install.googlecode.com/files/baz-20110610a.jar!/")
158
159(defmacro load-url-relative (path) 
160  `(load (format nil "~A~A" *url-jar-pathname-base* ,path)))
161
162(progn 
163  (deftest jar-pathname.load.http.1
164      (load-url-relative "foo")
165    t)
166
167  (deftest jar-pathname.load.http.2
168      (load-url-relative "bar")
169    t)
170
171  (deftest jar-pathname.load.http.3
172      (load-url-relative "bar.abcl")
173    t)
174
175  (deftest jar-pathname.load.http.4
176      (load-url-relative "eek")
177    t)
178
179  (deftest jar-pathname.load.http.5
180      (load-url-relative "eek.lisp")
181    t)
182
183  (deftest jar-pathname.load.http.6
184      (load-url-relative "a/b/foo")
185    t)
186
187  (deftest jar-pathname.load.http.7
188      (load-url-relative "a/b/bar")
189    t)
190
191  (deftest jar-pathname.load.http.8
192      (load-url-relative "a/b/bar.abcl")
193    t)
194
195  (deftest jar-pathname.load.http.9
196      (load-url-relative "a/b/eek")
197    t)
198
199  (deftest jar-pathname.load.http.10
200      (load-url-relative "a/b/eek.lisp")
201    t))
202
203(deftest jar-pathname.probe-file.1
204    (with-jar-file-init
205        (probe-file "jar:file:baz.jar!/eek.lisp"))
206  #p#.(format nil "jar:file:~A/baz.jar!/eek.lisp" 
207              (namestring *abcl-test-directory*)))
208
209(deftest jar-pathname.probe-file.2
210    (with-jar-file-init
211        (probe-file "jar:file:baz.jar!/a/b/bar.abcl"))
212  #p#.(format nil "jar:file:~A/baz.jar!/a/b/bar.abcl"
213              (namestring *tmp-directory*)))
214
215(deftest jar-pathname.probe-file.3
216    (with-jar-file-init
217        (probe-file "jar:jar:file:baz.jar!/a/b/bar.abcl!/bar._"))
218   #p#.(format nil "jar:jar:file:~Abaz.jar!/a/b/bar.abcl!/bar._"
219                       (namestring *tmp-directory*)))
220
221(push 'jar-pathname.probe-file.4 *expected-failures*)
222(deftest jar-pathname.probe-file.4
223    (with-jar-file-init
224        (probe-file "jar:file:baz.jar!/a/b"))
225  #p#.(format nil "jar:file:~Abaz.jar!/a/b/"
226                       (namestring *tmp-directory*)))
227
228(push 'jar-pathname.probe-file.5 *expected-failures*)
229(deftest jar-pathname.probe-file.5
230    (with-jar-file-init
231        (probe-file "jar:file:baz.jar!/a/b/"))
232  #p#.(format nil "jar:file:~Abaz.jar!/a/b/"
233                       (namestring *tmp-directory*)))
234
235(deftest jar-pathname.probe-file.6
236    (with-jar-file-init
237        (probe-file "jar:file:baz.jar!/d/e+f/bar.abcl"))
238  #p#.(format nil "jar:file:~Abaz.jar!/d/e+f/bar.abcl"
239                       (namestring *tmp-directory*)))
240
241(deftest jar-pathname.merge-pathnames.1
242    (merge-pathnames 
243     "/bar.abcl" #p"jar:file:baz.jar!/foo")
244  #p"jar:file:baz.jar!/bar.abcl")
245
246(deftest jar-pathname.merge-pathnames.2
247    (merge-pathnames 
248     "bar.abcl" #p"jar:file:baz.jar!/foo/")
249  #p"jar:file:baz.jar!/foo/bar.abcl")
250
251(deftest jar-pathname.merge-pathnames.3
252    (merge-pathnames 
253     "jar:file:baz.jar!/foo" "bar")
254  #p"jar:file:baz.jar!/foo")
255
256(deftest jar-pathname.merge-pathnames.4
257    (merge-pathnames 
258     "jar:file:baz.jar!/foo" "/a/b/c")
259  #p"jar:file:/a/b/baz.jar!/foo")
260
261
262;;; Under win32, we get the device in the merged path
263#+windows 
264(push 'jar-pathname.merge-pathnames.5 *expected-failures*)
265
266(deftest jar-pathname.merge-pathnames.5
267    (merge-pathnames "jar:file:/a/b/c/foo.jar!/bar/baz.lisp")
268  #p"jar:file:/a/b/c/foo.jar!/bar/baz.lisp")
269
270(deftest jar-pathname.truename.1
271    (signals-error (truename "jar:file:baz.jar!/foo")
272                   'file-error)
273  t)
274
275(deftest jar-pathname.1
276    (let* ((p #p"jar:file:foo/baz.jar!/")
277           (d (first (pathname-device p))))
278      (values
279       (pathname-directory d) (pathname-name d) (pathname-type d)))
280  (:relative "foo") "baz" "jar")
281
282(deftest jar-pathname.2
283    (let* ((p #p"jar:file:baz.jar!/foo.abcl")
284           (d (first (pathname-device p))))
285      (values
286       (pathname-name d) (pathname-type d) 
287       (pathname-directory p) (pathname-name p) (pathname-type p)))
288  "baz" "jar"
289   (:absolute) "foo" "abcl")
290   
291(deftest jar-pathname.3
292    (let* ((p #p"jar:jar:file:baz.jar!/foo.abcl!/")
293           (d0 (first (pathname-device p)))
294           (d1 (second (pathname-device p))))
295      (values 
296       (pathname-name d0) (pathname-type d0)
297       (pathname-name d1) (pathname-type d1)))
298  "baz" "jar"
299  "foo" "abcl")
300
301(deftest jar-pathname.4
302    (let* ((p #p"jar:jar:file:a/baz.jar!/b/c/foo.abcl!/this/that/foo-20.cls")
303           (d0 (first (pathname-device p)))
304           (d1 (second (pathname-device p))))
305      (values 
306       (pathname-directory d0) (pathname-name d0) (pathname-type d0)
307       (pathname-directory d1) (pathname-name d1) (pathname-type d1)
308       (pathname-directory p) (pathname-name p) (pathname-type p)))
309  (:relative "a") "baz" "jar"
310  (:relative "b" "c") "foo" "abcl"
311  (:absolute "this" "that") "foo-20" "cls")
312
313(deftest jar-pathname.5
314    (let* ((p #p"jar:jar:file:a/foo/baz.jar!/b/c/foo.abcl!/armed/bear/bar-1.cls")
315           (d0 (first (pathname-device p)))
316           (d1 (second (pathname-device p))))
317      (values 
318       (pathname-directory d0) (pathname-name d0) (pathname-type d0)
319       (pathname-directory d1) (pathname-name d1) (pathname-type d1)
320       (pathname-directory p) (pathname-name p) (pathname-type p)))
321  (:relative "a" "foo" ) "baz" "jar"
322  (:relative "b" "c") "foo" "abcl"
323  (:absolute "armed" "bear") "bar-1" "cls")
324
325(deftest jar-pathname.6
326    (let* ((p #p"jar:http://example.org/abcl.jar!/org/armedbear/lisp/Version.class")
327           (d (first (pathname-device p))))
328      (values 
329       (ext:pathname-url-p d)
330       (namestring d)
331       (pathname-directory p) (pathname-name p) (pathname-type p)))
332  t
333  "http://example.org/abcl.jar" 
334  (:absolute "org" "armedbear" "lisp") "Version" "class")
335
336(deftest jar-pathname.7
337    (let* ((p #p"jar:jar:http://example.org/abcl.jar!/foo.abcl!/foo-1.cls")
338           (d (pathname-device p))
339           (d0 (first d))
340           (d1 (second d)))
341      (values
342       (ext:pathname-url-p d0)
343       (namestring d0)
344       (pathname-name d1) (pathname-type d1)
345       (pathname-name p) (pathname-type p)))
346  t
347  "http://example.org/abcl.jar"
348  "foo" "abcl"
349  "foo-1" "cls")
350
351(deftest jar-pathname.8
352    (let* ((p #p"jar:file:/a/b/foo.jar!/")
353           (d (first (pathname-device p))))
354      (values
355       (pathname-directory d) (pathname-name d) (pathname-type d)))
356  (:ABSOLUTE "a" "b") "foo" "jar")
357
358(deftest jar-pathname.9
359    (let* ((p #p"jar:file:a/b/foo.jar!/c/d/foo.lisp")
360           (d (first (pathname-device p))))
361      (values
362       (pathname-directory d) (pathname-name d) (pathname-type d)
363       (pathname-directory p) (pathname-name p) (pathname-type p)))
364  (:relative "a" "b") "foo" "jar"
365  (:absolute "c" "d") "foo" "lisp")
366
367;;; 'jar:file:' forms must be URI encoded, meaning whitespace is not allowed
368(deftest jar-pathname.10
369    (signals-error 
370     (let ((s "jar:file:/foo/bar/a space/that!/this"))
371       (equal s
372              (namestring (pathname s))))
373     'file-error)
374  t)
375
376(deftest jar-pathname.11
377    (let ((s "jar:file:/foo/bar/a%20space%3f/that!/this"))
378      (string= s
379             (namestring (pathname s))))
380  t)
381
382;;; We allow jar-pathname to be contructed without a device to allow
383;;; MERGE-PATHNAMES to work, even though #p"file:" is illegal.
384(deftest jar-pathname.12
385    (string= (namestring (first (pathname-device #p"jar:file:!/foo.bar")))
386             "")
387  t)
388
389(deftest jar-pathname.match-p.1
390    (pathname-match-p "jar:file:/a/b/some.jar!/a/system/def.asd"
391                      "jar:file:/**/*.jar!/**/*.asd")
392  t)
393
394(deftest jar-pathname.match-p.2
395    (pathname-match-p "/a/system/def.asd"
396                      "jar:file:/**/*.jar!/**/*.asd")
397  nil)
398
399(deftest jar-pathname.match-p.3
400    (pathname-match-p "jar:file:/a/b/some.jar!/a/system/def.asd"
401                      "/**/*.asd")
402  nil)
403
404(deftest jar-pathname.translate.1
405    (translate-pathname "jar:file:/a/b/c.jar!/d/e/f.lisp" 
406      "jar:file:/**/*.jar!/**/*.*" 
407      "/foo/**/*.*")
408  #p"/foo/d/e/f.lisp")
409
410     
411
412       
413
414 
Note: See TracBrowser for help on using the repository browser.