guix: asdf-build-system: Only copy .asd for the package's systems.

* guix/build/asdf-build-system.scm (copy-files-to-output, install):
New asd-systems input parameter integrated into build system.

If the source code includes .asd files that are not meant to be loaded
in a package, those .asd should not be installed. Since ASDF requires
.asd file names to be unique, extraneous .asd files can cause conflicts
if there is more than one .asd file with the same name that should not
be loaded. This can happen if a project has example or template systems
that are not meant to be loaded.

Change-Id: Ib5772feab9d482c6327c31ead21330f49b257273
Signed-off-by: jgart <jgart@dismail.de>
This commit is contained in:
charje 2025-10-09 21:08:54 +00:00 committed by jgart
parent 9fe755d19f
commit 0a0cf3bad4
No known key found for this signature in database
GPG key ID: A52AA2B477B6DD35

View file

@ -79,11 +79,12 @@
(,(library-directory object-output)
:**/ :*.*.*)))
(define (copy-files-to-output out name)
(define (copy-files-to-output out name asd-systems)
"Copy all files from the current directory to OUT. Create an extra link to
any system-defining files in the source to a convenient location. This is
done before any compiling so that the compiled source locations will be
valid."
any system-defining files (with names found in ASD-SYSTEMS) in the source to a
convenient location; if ASD-SYSTEMS is empty then all system-defining files
will be linked. This is done before any compiling so that the compiled source
locations will be valid."
(let ((source (getcwd))
(target (source-directory out name))
(system-path (string-append out %system-install-prefix)))
@ -101,15 +102,19 @@ valid."
(mkdir-p system-path)
(for-each
(lambda (file)
(symlink file
(string-append system-path "/" (basename file))))
(when (or (not asd-systems)
(member (basename file) asd-systems))
(symlink file
(string-append system-path "/" (basename file)))))
(find-files target "\\.asd$"))
#t))
(define* (install #:key inputs outputs #:allow-other-keys)
(define* (install #:key inputs outputs asd-systems #:allow-other-keys)
"Copy and symlink all the source files.
The source files are taken from the corresponding compile package (e.g. SBCL)
if it's present in the native-inputs."
if it's present in the native-inputs. ASD-SYSTEMS is the list of ASDF systems
names for this package. If it is empty then all systems found will be
installed."
(define output (assoc-ref outputs "out"))
(define package-name
(package-name->name+version
@ -154,14 +159,14 @@ if it's present in the native-inputs."
"."))
(with-directory-excursion source-directory
(copy-files-to-output output package-name)))
(copy-files-to-output output package-name asd-systems)))
(define* (copy-source #:key outputs asd-systems #:allow-other-keys)
"Copy the source to the library output."
(let* ((out (library-output outputs))
(install-path (string-append out %source-install-prefix))
(system-name (main-system-name out)))
(copy-files-to-output out system-name)
(copy-files-to-output out system-name asd-systems)
;; Hide the files from asdf
(with-directory-excursion install-path
(rename-file "source" (%lisp-type))