diff --git a/find-system.lisp b/find-system.lisp index c0e6012f50c995f2437a7d48f68cbd3fa1de51a6..f9cfd2c24280cfab38f80a88b09a3a488ab73e95 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -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*) diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index 2cf2b02c58eb0fce2d87fb328b2257d3b3c9423b..ab32c86446b329f99c427ef689cb1dee0795c5d0 100644 --- a/parse-defsystem.lisp +++ b/parse-defsystem.lisp @@ -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