| 1 |
|
|---|
| 2 | (asdf:load-system :alexandria)
|
|---|
| 3 |
|
|---|
| 4 | (defun jbyte-array (vector)
|
|---|
| 5 | #+nil ;; TODO how do we do this?
|
|---|
| 6 | (jnew-array-from-array "byte" #(1 2 3))
|
|---|
| 7 | (let ((jarray (jnew-array "byte" (length vector))))
|
|---|
| 8 | (loop
|
|---|
| 9 | for index upfrom 0
|
|---|
| 10 | for el across vector
|
|---|
| 11 | do (setf (jarray-ref jarray index)
|
|---|
| 12 | (jcall-raw "byteValue" el)))
|
|---|
| 13 | jarray))
|
|---|
| 14 |
|
|---|
| 15 | (defun quick-jar (name &key manifest entries)
|
|---|
| 16 | (let* ((file-stream (jnew "java.io.FileOutputStream"
|
|---|
| 17 | (namestring name)))
|
|---|
| 18 | (mf (jnew "java.util.jar.Manifest")))
|
|---|
| 19 | (loop
|
|---|
| 20 | with main = (jcall "getMainAttributes" mf)
|
|---|
| 21 | for (key value) in manifest
|
|---|
| 22 | do (jcall "putValue" main key value))
|
|---|
| 23 | (let ((jar (jnew "java.util.jar.JarOutputStream"
|
|---|
| 24 | file-stream mf)))
|
|---|
| 25 | (loop
|
|---|
| 26 | for (entry-path filepath) in entries
|
|---|
| 27 | do
|
|---|
| 28 | (jcall "putNextEntry" jar
|
|---|
| 29 | (jnew "java.util.jar.JarEntry" entry-path))
|
|---|
| 30 | (jcall "write" jar
|
|---|
| 31 | (jbyte-array
|
|---|
| 32 | (alexandria:read-file-into-byte-vector
|
|---|
| 33 | filepath))))
|
|---|
| 34 | (jcall "close" jar)
|
|---|
| 35 | name)))
|
|---|
| 36 |
|
|---|
| 37 | (defparameter *report-index* 0)
|
|---|
| 38 | (defmacro report-error (form)
|
|---|
| 39 | (alexandria:with-unique-names (result err)
|
|---|
| 40 | `(multiple-value-bind (,result ,err)
|
|---|
| 41 | (ignore-errors ,form)
|
|---|
| 42 | (incf *report-index*)
|
|---|
| 43 | (when ,err
|
|---|
| 44 | (format t "~&~a: " *report-index*)
|
|---|
| 45 | (format t (simple-condition-format-control ,err)
|
|---|
| 46 | (simple-condition-format-arguments ,err))
|
|---|
| 47 | (terpri)))))
|
|---|
| 48 |
|
|---|
| 49 | ;; ----------------------------------------
|
|---|
| 50 |
|
|---|
| 51 | (setf *default-pathname-defaults*
|
|---|
| 52 | #p"/Users/evenson/work/abcl/abcl-space-in-pathname/"
|
|---|
| 53 | #+nil #P"/home/tyc20/lisp/abcl-space-in-pathname/")
|
|---|
| 54 |
|
|---|
| 55 | (ensure-directories-exist *default-pathname-defaults*)
|
|---|
| 56 |
|
|---|
| 57 | (alexandria:write-string-into-file "" "foo.lisp"
|
|---|
| 58 | :if-exists :supersede)
|
|---|
| 59 |
|
|---|
| 60 | (compile-file "foo.lisp")
|
|---|
| 61 |
|
|---|
| 62 | (report-error (load "foo.lisp"))
|
|---|
| 63 |
|
|---|
| 64 | (compile-file "foo.lisp" :output-file "/tmp/foo.abcl")
|
|---|
| 65 |
|
|---|
| 66 | (report-error (load "jar:file:/tmp/foo.abcl!/foo._"))
|
|---|
| 67 |
|
|---|
| 68 | (compile-file "foo.lisp" :output-file "/tmp/foo bar.abcl")
|
|---|
| 69 |
|
|---|
| 70 | (report-error (load "/tmp/foo bar.abcl"))
|
|---|
| 71 |
|
|---|
| 72 | (report-error (load "jar:file:/tmp/foo bar.abcl!/foo._"))
|
|---|
| 73 |
|
|---|
| 74 | (report-error (load "jar:file:/tmp/foo%20bar.abcl!/foo%20bar._"))
|
|---|
| 75 |
|
|---|
| 76 | (alexandria:copy-file "/tmp/foo.abcl" "/tmp/foo bar.abcl")
|
|---|
| 77 |
|
|---|
| 78 | (report-error (load "jar:file:/tmp/foo%20bar.abcl!/foo._"))
|
|---|
| 79 |
|
|---|
| 80 | (alexandria:copy-file "/tmp/foo.abcl" "/tmp/a space/foo bar.abcl")
|
|---|
| 81 |
|
|---|
| 82 | (report-error (load "jar:file:/tmp/foo%20bar.abcl!/foo._"))
|
|---|
| 83 |
|
|---|
| 84 | (rename-file "/tmp/foo bar.abcl" "/tmp/foo.abcl")
|
|---|
| 85 |
|
|---|
| 86 | (report-error (load "jar:file:/tmp/hello.abcl!/hello%20space._"))
|
|---|
| 87 |
|
|---|
| 88 | (report-error (load "jar:file:/tmp/hello.abcl!/hello space._"))
|
|---|
| 89 |
|
|---|
| 90 | (alexandria:copy-file "foo.lisp" "/tmp/foo.lisp")
|
|---|
| 91 |
|
|---|
| 92 | (report-error (load "/tmp/hello.lisp"))
|
|---|
| 93 |
|
|---|
| 94 | (alexandria:copy-file "foo.lisp" "/tmp/foo bar.lisp")
|
|---|
| 95 |
|
|---|
| 96 | (report-error (load "/tmp/foo bar.lisp"))
|
|---|
| 97 |
|
|---|
| 98 | (defparameter *jar-tests*
|
|---|
| 99 | '((#P"/tmp/xx.jar"
|
|---|
| 100 | (("foo.abcl" "foo.abcl"))
|
|---|
| 101 | "jar:file:/tmp/xx.jar!/foo.abcl")
|
|---|
| 102 |
|
|---|
| 103 | (#P"/tmp/a space/xx.jar"
|
|---|
| 104 | (("foo.abcl" "foo.abcl"))
|
|---|
| 105 | "jar:file:/tmp/a%20space/xx.jar!/foo.abcl")
|
|---|
| 106 |
|
|---|
| 107 | (#P"/tmp/a space/xx.jar"
|
|---|
| 108 | (("foo.abcl" "foo.abcl"))
|
|---|
| 109 | "jar:file:/tmp/a space/xx.jar!/foo.abcl")
|
|---|
| 110 |
|
|---|
| 111 | (#P"/tmp/xx.jar"
|
|---|
| 112 | (("foo bar.abcl" "foo.abcl"))
|
|---|
| 113 | "jar:file:/tmp/xx.jar!/foo%20bar.abcl")
|
|---|
| 114 |
|
|---|
| 115 | (#P"/tmp/xx.jar"
|
|---|
| 116 | (("foo bar.abcl" "foo.abcl"))
|
|---|
| 117 | "jar:file:/tmp/xx.jar!/foo bar.abcl")
|
|---|
| 118 |
|
|---|
| 119 | (#P"/tmp/xx.jar"
|
|---|
| 120 | (("xx/foo bar.abcl" "foo.abcl"))
|
|---|
| 121 | "jar:file:/tmp/xx.jar!/xx/foo bar.abcl")))
|
|---|
| 122 |
|
|---|
| 123 | (loop
|
|---|
| 124 | for (jar entries load-path) in *jar-tests*
|
|---|
| 125 | do
|
|---|
| 126 | (quick-jar (ensure-directories-exist jar) :entries entries)
|
|---|
| 127 | do (report-error (load load-path)))
|
|---|
| 128 |
|
|---|
| 129 |
|
|---|
