Commit 38dfc6d6 authored by Robert P. Goldman's avatar Robert P. Goldman
Browse files

Patch to enforce system naming conventions.

Insist on lower-case system names, with only the characters accetpable
in logical pathnames and the forward slash, "/", which is meaningful to
parent f9105317
......@@ -77,10 +77,24 @@ of which is a system object.")
(loop :for registered :being :the :hash-values :of *defined-systems*
:collect (coerce-name (cdr registered))))
(defun check-acceptable-system-name (name)
(flet ((acceptable-char-p (c)
;; these two are acceptable characters for logical pathnames
(alphanumericp c)
(eql c #\-)
;; forward slash has a special meaning to ASDF
(eql c #\/))))
(let ((unacceptable (find-if-not #'acceptable-char-p name)))
(when unacceptable
(sysdef-error (compatfmt "~@<Bad character for system name: ~c in ~3i~_~A~@:>") unacceptable name)))
(defun register-system (system)
(check-type system system)
(let ((name (component-name system)))
(check-type name string)
(check-acceptable-system-name name)
(asdf-message (compatfmt "~&~@<; ~@;Registering ~3i~_~A~@:>~%") system)
(unless (eq system (cdr (gethash name *defined-systems*)))
(setf (gethash name *defined-systems*)
......@@ -247,7 +247,7 @@ system names contained using COERCE-NAME. Return the result."
;; that is registered to a different location to find-system,
;; we also need to remember it in a special variable *systems-being-defined*.
(with-system-definitions ()
(let* ((name (coerce-name name))
(let* ((name (string-downcase (coerce-name name)))
(source-file (if sfp source-file (resolve-symlinks* (load-pathname))))
(registered (system-registered-p name))
(registered! (if registered
Supports Markdown
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