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