contrib/abcl-build: fix path introspection under Windows

Fix ABCL-BUILD tests so that they run to completion.
parent f7daf624
......@@ -16,7 +16,8 @@
;; utility functions that should be moved into utility package
#:introspect-path-for
#:split-string
#:localize-executable-name
#:possible-executable-names
#:probe-for-executable
#:stringify
#:listify
#:some-directory
......
(in-package :abcl/build/t)
(if (not (ignore-errors (asdf:find-system :abcl)))
(prove:diag "Unable to find 'abcl.asd'.~&Enable ASDF to find 'abcl.asd' by adding symlink to ~/common-lisp/ to ABCL source directory.")
(prove:diag "Unable to find 'abcl.asd'.~&Enable ASDF to find 'abcl.asd' by adding symlink to ~~/common-lisp/ to ABCL source directory.")
(prove:subtest "Testing BUILD-ABCL."
(prove:plan 2)
(prove:ok
......
......@@ -5,10 +5,11 @@
(prove:ok
(abcl/build:mvn/install))
(prove:plan 1)
(let ((pom (asdf:system-relative-pathname :abcl "pom.xml")))
(prove:diag (format nil "Testing invocation of private Maven on root ABCL POM at~&~2,t~a…"
pom))
(prove:ok (abcl/build:mvn/call pom "install")))
(if (not (ignore-errors (asdf:find-system :abcl)))
(prove:diag "Unable to find 'abcl.asd'.~&Enable ASDF to find 'abcl.asd' by adding symlink to ~~/common-lisp/ to ABCL source directory.")
(let ((pom (asdf:system-relative-pathname :abcl "pom.xml")))
(prove:ok (abcl/build:mvn/call pom "install")
(format nil "Testing invocation of private Maven on root ABCL POM at~&~2,t~a…"
pom))))
(prove:finalize)
(in-package :abcl/build/t)
(let ((executable
(abcl/build:localize-executable-name "java"))) ;; RUNTIME difference
(let ((possible-executables
(abcl/build:possible-executable-names "java")))
(prove:plan 1)
(prove:ok executable)
(if (uiop:os-windows-p)
(prove:plan 1)
(prove:is (pathname-type executable) "exe")))
(prove:is-type possible-executables
'cons))
(prove:plan 1)
(prove:is (length (abcl/build:split-string "one.two.three." #\.))
......
;;;; TODO: move to a utility package
(in-package :abcl/build)
;;; TODO remove
(defun localize-executable-name (name)
(let* ((p (if (pathnamep name)
name
......@@ -13,30 +14,49 @@
"exe")
type))))
(defun possible-executable-names (name
&key (suffixes '("exe" "cmd" "bat") suffixes-p))
(let* ((p (if (pathnamep name)
name
(pathname name)))
(type (pathname-type p)))
(unless (or (uiop:os-windows-p) suffixes-p)
(return-from possible-executable-names
(listify name)))
(loop
:for suffix :in suffixes
:with result = (list p)
:doing (push (make-pathname :defaults p :type suffix)
result)
:finally (return (nreverse result)))))
(defun introspect-path-for (executable)
(let ((which-command (if (uiop:os-windows-p)
"where"
"which")))
(when (ignore-errors
(uiop:run-program (list which-command which-command) :output :string))
(let ((raw-result
(uiop:run-program
(list which-command
(namestring (localize-executable-name executable)))
:output :string)))
(let ((result
(string-trim
'(#\Space #\Newline #\Backspace #\Tab
#\Linefeed #\Page #\Return #\Rubout)
raw-result)))
(values
result
(pathname result)))))))
(dolist (p (possible-executable-names executable))
(let ((raw-result
(ignore-errors (uiop:run-program
(list which-command
(namestring p))
:output :string))))
(when raw-result
(let ((result (first (split-string raw-result #\Newline))))
(return-from introspect-path-for
(values
result
(pathname result))))))))))
(defun probe-executable (directory executable)
(probe-file
(localize-executable-name
(merge-pathnames executable directory))))
(defun probe-for-executable (directory executable)
(dolist (p (possible-executable-names executable))
(let ((pathname
(probe-file
(merge-pathnames executable directory))))
(when pathname
(return-from probe-for-executable
pathname)))))
(defun split-string (string split-char)
(loop :for i = 0 :then (1+ j)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment