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
Loading
Loading
Loading
Loading
+14 −0
Original line number Diff line number Diff line
@@ -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)
                              (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)
    (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*)
+1 −1
Original line number Diff line number Diff line
@@ -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