From 32eef692c96fe8d5051def4afd2a211222160db2 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@sift.net> Date: Sun, 20 Mar 2016 14:53:20 -0500 Subject: [PATCH] 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. --- test/script-support.lisp | 38 +++++++++++++++++++++++++++++++++++--- 1 file changed, 35 insertions(+), 3 deletions(-) diff --git a/test/script-support.lisp b/test/script-support.lisp index 56ced3f69..c60796f31 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -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* -- GitLab