Skip to content
Snippets Groups Projects
Commit 4ddaabe8 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

1.631: Allow for $SBCL_HOME being undefined,

and more generally allow source-registry entries to be NIL.
Rename split to split-string since we changed its API,
otherwise some hot upgrades break.
parent 7e85eb94
No related branches found
No related tags found
No related merge requests found
...@@ -111,7 +111,7 @@ ...@@ -111,7 +111,7 @@
':asdf-utilities ':asdf-utilities
:nicknames '(#:asdf-extensions) :nicknames '(#:asdf-extensions)
:use '(#:common-lisp) :use '(#:common-lisp)
:unintern '(#:make-collector) :unintern '(#:split #:make-collector)
:export :export
'(#:absolute-pathname-p '(#:absolute-pathname-p
#:aif #:aif
...@@ -131,7 +131,7 @@ ...@@ -131,7 +131,7 @@
#:remove-keys #:remove-keys
#:remove-keyword #:remove-keyword
#:resolve-symlinks #:resolve-symlinks
#:split #:split-string
#:component-name-to-pathname-components #:component-name-to-pathname-components
#:split-name-type #:split-name-type
#:system-registered-p #:system-registered-p
...@@ -247,7 +247,7 @@ ...@@ -247,7 +247,7 @@
;; This parameter isn't actually user-visible ;; This parameter isn't actually user-visible
;; -- please use the exported function ASDF:ASDF-VERSION below. ;; -- please use the exported function ASDF:ASDF-VERSION below.
;; the 1+ hair is to ensure that we don't do an inadvertent find and replace ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
(subseq "VERSION:1.630" (1+ (length "VERSION")))) (subseq "VERSION:1.631" (1+ (length "VERSION"))))
(defun asdf-version () (defun asdf-version ()
"Exported interface to the version of ASDF currently installed. A string. "Exported interface to the version of ASDF currently installed. A string.
...@@ -523,7 +523,7 @@ does not have an absolute directory, then the HOST and DEVICE come from the DEFA ...@@ -523,7 +523,7 @@ does not have an absolute directory, then the HOST and DEVICE come from the DEFA
(declare (dynamic-extent format-args)) (declare (dynamic-extent format-args))
(apply #'format *verbose-out* format-string format-args)) (apply #'format *verbose-out* format-string format-args))
(defun split (string &key max (separator '(#\Space #\Tab))) (defun split-string (string &key max (separator '(#\Space #\Tab)))
;; Beware: this API function has changed in ASDF 1.628! ;; Beware: this API function has changed in ASDF 1.628!
;; optional arguments became keyword arguments, and max now works from the end. ;; optional arguments became keyword arguments, and max now works from the end.
"Split STRING in components separater by any of the characters in the sequence SEPARATOR, "Split STRING in components separater by any of the characters in the sequence SEPARATOR,
...@@ -546,7 +546,7 @@ starting the separation from the end, e.g. when called with arguments ...@@ -546,7 +546,7 @@ starting the separation from the end, e.g. when called with arguments
(defun split-name-type (filename) (defun split-name-type (filename)
(destructuring-bind (name &optional type) (destructuring-bind (name &optional type)
(split filename :max 2 :separator ".") (split-string filename :max 2 :separator ".")
(if (equal name "") (if (equal name "")
(values filename nil) (values filename nil)
(values name type)))) (values name type))))
...@@ -568,7 +568,7 @@ The intention of this function is to support structured component names, ...@@ -568,7 +568,7 @@ The intention of this function is to support structured component names,
e.g., \(:file \"foo/bar\"\), which will be unpacked to relative e.g., \(:file \"foo/bar\"\), which will be unpacked to relative
pathnames." pathnames."
(check-type s string) (check-type s string)
(let* ((components (split s :separator "/")) (let* ((components (split-string s :separator "/"))
(last-comp (car (last components)))) (last-comp (car (last components))))
(multiple-value-bind (relative components) (multiple-value-bind (relative components)
(if (equal (first components) "") (if (equal (first components) "")
...@@ -905,9 +905,9 @@ actually-existing directory." ...@@ -905,9 +905,9 @@ actually-existing directory."
(defmethod version-satisfies ((cver string) version) (defmethod version-satisfies ((cver string) version)
(let ((x (mapcar #'parse-integer (let ((x (mapcar #'parse-integer
(split cver :separator "."))) (split-string cver :separator ".")))
(y (mapcar #'parse-integer (y (mapcar #'parse-integer
(split version :separator ".")))) (split-string version :separator "."))))
(labels ((bigger (x y) (labels ((bigger (x y)
(cond ((not y) t) (cond ((not y) t)
((not x) nil) ((not x) nil)
...@@ -2349,7 +2349,7 @@ with a different configuration, so the configuration would be re-read then." ...@@ -2349,7 +2349,7 @@ with a different configuration, so the configuration would be re-read then."
(and (consp directive) (and (consp directive)
(or (and (length=n-p directive 2) (or (and (length=n-p directive 2)
(or (and (eq (first directive) :include) (or (and (eq (first directive) :include)
(typep (second directive) '(or string pathname))) (typep (second directive) '(or string pathname null)))
(and (location-designator-p (first directive)) (and (location-designator-p (first directive))
(or (location-designator-p (second directive)) (or (location-designator-p (second directive))
(null (second directive)))))) (null (second directive))))))
...@@ -2496,7 +2496,8 @@ with a different configuration, so the configuration would be re-read then." ...@@ -2496,7 +2496,8 @@ with a different configuration, so the configuration would be re-read then."
(let ((src (first directive)) (let ((src (first directive))
(dst (second directive))) (dst (second directive)))
(if (eq src :include) (if (eq src :include)
(process-output-translations (pathname dst) :inherit nil :collect collect) (when dst
(process-output-translations (pathname dst) :inherit nil :collect collect))
(let* ((trusrc (truenamize (resolve-location src t))) (let* ((trusrc (truenamize (resolve-location src t)))
(trudst (if dst (resolve-location dst t) trusrc))) (trudst (if dst (resolve-location dst t) trusrc)))
(funcall collect (list trusrc trudst))))))) (funcall collect (list trusrc trudst)))))))
...@@ -2679,7 +2680,7 @@ with a different configuration, so the configuration would be re-read then." ...@@ -2679,7 +2680,7 @@ with a different configuration, so the configuration would be re-read then."
(case kw (case kw
((:include :directory :tree) ((:include :directory :tree)
(and (length=n-p rest 1) (and (length=n-p rest 1)
(typep (car rest) '(or pathname string)))) (typep (car rest) '(or pathname string null))))
((:exclude) ((:exclude)
(every #'stringp rest)) (every #'stringp rest))
(null rest)))) (null rest))))
...@@ -2819,10 +2820,12 @@ with a different configuration, so the configuration would be re-read then." ...@@ -2819,10 +2820,12 @@ with a different configuration, so the configuration would be re-read then."
(process-source-registry (pathname pathname) :inherit nil :register register))) (process-source-registry (pathname pathname) :inherit nil :register register)))
((:directory) ((:directory)
(destructuring-bind (pathname) rest (destructuring-bind (pathname) rest
(funcall register pathname))) (when pathname
(funcall register pathname))))
((:tree) ((:tree)
(destructuring-bind (pathname) rest (destructuring-bind (pathname) rest
(funcall register pathname :recurse t :exclude *default-exclusions*))) (when pathname
(funcall register pathname :recurse t :exclude *default-exclusions*))))
((:exclude) ((:exclude)
(setf *default-exclusions* rest)) (setf *default-exclusions* rest))
((:default-registry) ((:default-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