diff --git a/system.lisp b/system.lisp index d08f0eaead1900a6aa4551026f7571235c5d9428..31ff92b078f40d81d3c8cdda8cd9d90755505ffd 100644 --- a/system.lisp +++ b/system.lisp @@ -137,16 +137,18 @@ primary system, after which the .asd file in which it is defined is named. If given a string or symbol (to downcase), do it syntactically by stripping anything from the first slash on. If given a component, do it semantically by extracting -the system-primary-system-name of its system." +the system-primary-system-name of its system from its source-file if any, +falling back to the syntactic criterion if none." (etypecase system-designator (string (if-let (p (position #\/ system-designator)) (subseq system-designator 0 p) system-designator)) (symbol (primary-system-name (coerce-name system-designator))) (component (let* ((system (component-system system-designator)) (source-file (physicalize-pathname (system-source-file system)))) - (and source-file - (equal (pathname-type source-file) "asd") - (pathname-name source-file)))))) + (if source-file + (and (equal (pathname-type source-file) "asd") + (pathname-name source-file)) + (primary-system-name (component-name system))))))) (defun primary-system-p (system) "Given a system designator SYSTEM, return T if it designates a primary system, or else NIL.