source: branches/0.23.x/abcl/test/lisp/abcl/jar-pathname.lisp

Last change on this file was 13066, checked in by Mark Evenson, 13 years ago

[backport r13057] Tests for the implementation of URI encoding.

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