Skip to content
Snippets Groups Projects
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
ASDF.
parent f9105317
No related branches found
No related tags found
No related merge requests found
...@@ -77,10 +77,24 @@ of which is a system object.") ...@@ -77,10 +77,24 @@ of which is a system object.")
(loop :for registered :being :the :hash-values :of *defined-systems* (loop :for registered :being :the :hash-values :of *defined-systems*
:collect (coerce-name (cdr registered)))) :collect (coerce-name (cdr registered))))
(defun check-acceptable-system-name (name)
(flet ((acceptable-char-p (c)
(or
;; 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)))
t))
(defun register-system (system) (defun register-system (system)
(check-type system system) (check-type system system)
(let ((name (component-name system))) (let ((name (component-name system)))
(check-type name string) (check-type name string)
(check-acceptable-system-name name)
(asdf-message (compatfmt "~&~@<; ~@;Registering ~3i~_~A~@:>~%") system) (asdf-message (compatfmt "~&~@<; ~@;Registering ~3i~_~A~@:>~%") system)
(unless (eq system (cdr (gethash name *defined-systems*))) (unless (eq system (cdr (gethash name *defined-systems*)))
(setf (gethash name *defined-systems*) (setf (gethash name *defined-systems*)
......
...@@ -247,7 +247,7 @@ system names contained using COERCE-NAME. Return the result." ...@@ -247,7 +247,7 @@ system names contained using COERCE-NAME. Return the result."
;; that is registered to a different location to find-system, ;; that is registered to a different location to find-system,
;; we also need to remember it in a special variable *systems-being-defined*. ;; we also need to remember it in a special variable *systems-being-defined*.
(with-system-definitions () (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)))) (source-file (if sfp source-file (resolve-symlinks* (load-pathname))))
(registered (system-registered-p name)) (registered (system-registered-p name))
(registered! (if registered (registered! (if registered
......
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