Ticket #151: test.lisp

(asdf:load-system :alexandria)

(defun jbyte-array (vector)
  #+nil ;; TODO how do we do this?
  (jnew-array-from-array "byte" #(1 2 3))
  (let ((jarray (jnew-array "byte" (length vector))))
    (loop
       for index upfrom 0
       for el across vector
       do (setf (jarray-ref jarray index)
                (jcall-raw "byteValue" el)))
    jarray))

(defun quick-jar (name &key manifest entries)
  (let* ((file-stream (jnew "java.io.FileOutputStream"
                            (namestring name)))
         (mf (jnew "java.util.jar.Manifest")))
    (loop
       with main = (jcall "getMainAttributes" mf)
       for (key value) in manifest
       do (jcall "putValue" main key value))
    (let ((jar (jnew "java.util.jar.JarOutputStream"
                     file-stream mf)))
      (loop
         for (entry-path filepath) in entries
         do
         (jcall "putNextEntry" jar
                (jnew "java.util.jar.JarEntry" entry-path))
         (jcall "write" jar
                (jbyte-array
                 (alexandria:read-file-into-byte-vector
                  filepath))))
      (jcall "close" jar)
      name)))

(defparameter *report-index* 0)
(defmacro report-error (form)
  (alexandria:with-unique-names (result err)
    `(multiple-value-bind (,result ,err)
         (ignore-errors ,form)
       (incf *report-index*)
       (when ,err
         (format t "~&~a:  " *report-index*)
         (format t (simple-condition-format-control ,err)
                 (simple-condition-format-arguments ,err))
         (terpri)))))

;; ----------------------------------------

(setf *default-pathname-defaults* 
      #p"/Users/evenson/work/abcl/abcl-space-in-pathname/"
      #+nil #P"/home/tyc20/lisp/abcl-space-in-pathname/")

(ensure-directories-exist *default-pathname-defaults*)

(alexandria:write-string-into-file "" "foo.lisp"
                                   :if-exists :supersede)

(compile-file "foo.lisp")

(report-error (load "foo.lisp"))

(compile-file "foo.lisp" :output-file "/tmp/foo.abcl")

(report-error (load "jar:file:/tmp/foo.abcl!/foo._"))

(compile-file "foo.lisp" :output-file "/tmp/foo bar.abcl")

(report-error (load "/tmp/foo bar.abcl"))

(report-error (load "jar:file:/tmp/foo bar.abcl!/foo._"))

(report-error (load "jar:file:/tmp/foo%20bar.abcl!/foo%20bar._"))

(alexandria:copy-file "/tmp/foo.abcl" "/tmp/foo bar.abcl")

(report-error (load "jar:file:/tmp/foo%20bar.abcl!/foo._"))

(alexandria:copy-file "/tmp/foo.abcl" "/tmp/a space/foo bar.abcl")

(report-error (load "jar:file:/tmp/foo%20bar.abcl!/foo._"))

(rename-file "/tmp/foo bar.abcl" "/tmp/foo.abcl")

(report-error (load "jar:file:/tmp/hello.abcl!/hello%20space._"))

(report-error (load "jar:file:/tmp/hello.abcl!/hello space._"))

(alexandria:copy-file "foo.lisp" "/tmp/foo.lisp")

(report-error (load "/tmp/hello.lisp"))

(alexandria:copy-file "foo.lisp" "/tmp/foo bar.lisp")

(report-error (load "/tmp/foo bar.lisp"))

(defparameter *jar-tests*
  '((#P"/tmp/xx.jar"
     (("foo.abcl" "foo.abcl"))
     "jar:file:/tmp/xx.jar!/foo.abcl")

    (#P"/tmp/a space/xx.jar"
     (("foo.abcl" "foo.abcl"))
     "jar:file:/tmp/a%20space/xx.jar!/foo.abcl")

    (#P"/tmp/a space/xx.jar"
     (("foo.abcl" "foo.abcl"))
     "jar:file:/tmp/a space/xx.jar!/foo.abcl")

    (#P"/tmp/xx.jar"
     (("foo bar.abcl" "foo.abcl"))
     "jar:file:/tmp/xx.jar!/foo%20bar.abcl")

    (#P"/tmp/xx.jar"
     (("foo bar.abcl" "foo.abcl"))
     "jar:file:/tmp/xx.jar!/foo bar.abcl")

    (#P"/tmp/xx.jar"
     (("xx/foo bar.abcl" "foo.abcl"))
     "jar:file:/tmp/xx.jar!/xx/foo bar.abcl")))

(loop
   for (jar entries load-path) in *jar-tests*
   do
   (quick-jar (ensure-directories-exist jar) :entries entries)
   do (report-error (load load-path)))