Skip to content
Snippets Groups Projects
Commit 7e38b1e7 authored by Nikodemus Siivola's avatar Nikodemus Siivola
Browse files

deal with empty SBCL_HOME

 * Merged from SBCL CVS.

 * Original patch by Michael Weber.

 * Trailing whitespace cleanup.
parent 547581bf
No related branches found
No related tags found
No related merge requests found
;;; This is asdf: Another System Definition Facility. $Revision: 1.113 $ ;;; This is asdf: Another System Definition Facility. $Revision: 1.114 $
;;; ;;;
;;; Feedback, bug reports, and patches are all welcome: please mail to ;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; <cclan-list@lists.sf.net>. But note first that the canonical ;;; <cclan-list@lists.sf.net>. But note first that the canonical
...@@ -502,7 +502,7 @@ system.")) ...@@ -502,7 +502,7 @@ system."))
(cons (class-name (class-of o)) c)) (cons (class-name (class-of o)) c))
(defgeneric operation-ancestor (operation) (defgeneric operation-ancestor (operation)
(:documentation (:documentation
"Recursively chase the operation's parent pointer until we get to "Recursively chase the operation's parent pointer until we get to
the head of the tree")) the head of the tree"))
...@@ -666,7 +666,7 @@ the head of the tree")) ...@@ -666,7 +666,7 @@ the head of the tree"))
;; in-order-to slot with canonicalized ;; in-order-to slot with canonicalized
;; names instead of coercing this late ;; names instead of coercing this late
(coerce-name required-c) required-v) (coerce-name required-c) required-v)
(error 'missing-dependency (error 'missing-dependency
:required-by c :required-by c
:version required-v :version required-v
:requires required-c))) :requires required-c)))
...@@ -675,9 +675,9 @@ the head of the tree")) ...@@ -675,9 +675,9 @@ the head of the tree"))
(do-dep (op dep) (do-dep (op dep)
(cond ((eq op 'feature) (cond ((eq op 'feature)
(or (member (car dep) *features*) (or (member (car dep) *features*)
(error 'missing-dependency (error 'missing-dependency
:required-by c :required-by c
:requires (car dep) :requires (car dep)
:version nil))) :version nil)))
(t (t
(dolist (d dep) (dolist (d dep)
...@@ -866,13 +866,13 @@ the head of the tree")) ...@@ -866,13 +866,13 @@ the head of the tree"))
nil) nil)
(defgeneric load-preferences (system operation) (defgeneric load-preferences (system operation)
(:documentation (:documentation
"Called to load system preferences after <perform operation "Called to load system preferences after <perform operation
system>. Typical uses are to set parameters that don't exist until system>. Typical uses are to set parameters that don't exist until
after the system has been loaded.")) after the system has been loaded."))
(defgeneric preference-file-for-system/operation (system operation) (defgeneric preference-file-for-system/operation (system operation)
(:documentation (:documentation
"Returns the pathname of the preference file for this system. "Returns the pathname of the preference file for this system.
Called by 'load-preferences to determine what file to load.")) Called by 'load-preferences to determine what file to load."))
...@@ -1290,7 +1290,7 @@ output to *VERBOSE-OUT*. Returns the shell's exit code." ...@@ -1290,7 +1290,7 @@ output to *VERBOSE-OUT*. Returns the shell's exit code."
(defun contrib-sysdef-search (system) (defun contrib-sysdef-search (system)
(let ((home (sb-ext:posix-getenv "SBCL_HOME"))) (let ((home (sb-ext:posix-getenv "SBCL_HOME")))
(when home (when (and home (not (string= home "")))
(let* ((name (coerce-name system)) (let* ((name (coerce-name system))
(home (truename home)) (home (truename home))
(contrib (merge-pathnames (contrib (merge-pathnames
...@@ -1304,7 +1304,7 @@ output to *VERBOSE-OUT*. Returns the shell's exit code." ...@@ -1304,7 +1304,7 @@ output to *VERBOSE-OUT*. Returns the shell's exit code."
(pushnew (pushnew
'(let ((home (sb-ext:posix-getenv "SBCL_HOME"))) '(let ((home (sb-ext:posix-getenv "SBCL_HOME")))
(when home (when (and home (not (string= home "")))
(merge-pathnames "site-systems/" (truename home)))) (merge-pathnames "site-systems/" (truename home))))
*central-registry*) *central-registry*)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment