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

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

Add tests for whitespace in pathname.

Refactor jar-pathname tests via LOAD-JAR-RELATIVE macro.

Use DEFPARAMETER rather than DEFVAR.

Add paths containing whitespace to local jar in preparation for
expanding the test suite to more failing cases.

*TMP-JAR_PATH* now contains the path to jar used for testing.

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