Commit 32eef692 authored by Robert Goldman's avatar Robert Goldman

Allow ASDF directory to be found by environment variable.

Trying to test ASDF on Windows, running the makefile in cygwin was
ending up causing troubles where the cygwin pathnames would get into
lisp, where they would be useless. So we allow the tester to specify the
location of ASDF with an environment variable instead.
parent 95813304
......@@ -205,9 +205,41 @@ Some constraints:
;; We still want to work despite and host/device funkiness,
;; so we do it the hard way.
(defparameter *test-directory*
(truename
(make-pathname :name nil :type nil :version nil
:defaults (or *load-pathname* *compile-file-pathname* *default-pathname-defaults*))))
;; the following is annoyingly named "test-getenv" to avoid symbol clash
;; later when we use UIOP.
(flet ((test-getenv (x)
(declare (ignorable x))
#+(or abcl clasp clisp ecl xcl) (ext:getenv x)
#+allegro (sys:getenv x)
#+clozure (ccl:getenv x)
#+cmucl (unix:unix-getenv x)
#+scl (cdr (assoc x ext:*environment-list* :test #'string=))
#+cormanlisp
(let* ((buffer (ct:malloc 1))
(cname (ct:lisp-string-to-c-string x))
(needed-size (win:getenvironmentvariable cname buffer 0))
(buffer1 (ct:malloc (1+ needed-size))))
(prog1 (if (zerop (win:getenvironmentvariable cname buffer1 needed-size))
nil
(ct:c-string-to-lisp-string buffer1))
(ct:free buffer)
(ct:free buffer1)))
#+gcl (system:getenv x)
#+genera nil
#+lispworks (lispworks:environment-variable x)
#+mcl (ccl:with-cstrs ((name x))
(let ((value (_getenv name)))
(unless (ccl:%null-ptr-p value)
(ccl:%get-cstring value))))
#+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) x)
#+sbcl (sb-ext:posix-getenv x)
#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
(error "~S is not supported on your implementation" 'getenv)))
(or (test-getenv "ASDF_TEST_DIRECTORY")
(truename
(make-pathname :name nil :type nil :version nil
:defaults (or *load-pathname* *compile-file-pathname* *default-pathname-defaults*))))))
(defun make-sub-pathname (&rest keys &key defaults &allow-other-keys)
(merge-pathnames (apply 'make-pathname keys) defaults))
(defparameter *asdf-directory*
......
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