mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
build-system: asdf: Work around package-name->name+version bug.
This patch modifies how the name of the main Common Lisp system is extracted from the full Guix package name to work around bug#48225 concerning the 'package-name->name+version' function. Fixes <https://issues.guix.gnu.org/41437>. * guix/build-system/asdf.scm (asdf-build): Fix 'systems' function. * guix/build/asdf-build-system.scm (main-system-name): Fix it.
This commit is contained in:
parent
e5adaf6c2d
commit
2fa8fd4af5
2 changed files with 17 additions and 16 deletions
|
@ -1,6 +1,6 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
|
||||
;;; Copyright © 2019, 2020 Guillaume Le Vaillant <glv@posteo.net>
|
||||
;;; Copyright © 2019, 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -291,16 +291,16 @@ (define (asdf-build lisp-type)
|
|||
(imported-modules %asdf-build-system-modules)
|
||||
(modules %asdf-build-modules))
|
||||
|
||||
;; FIXME: The definition of 'systems' is pretty hacky.
|
||||
;; Is there a more elegant way to do it?
|
||||
(define systems
|
||||
(if (null? (cadr asd-systems))
|
||||
`(quote
|
||||
,(list
|
||||
(string-drop
|
||||
;; NAME is the value returned from `package-full-name'.
|
||||
(hyphen-separated-name->name+version name)
|
||||
(1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix.
|
||||
;; FIXME: Find a more reliable way to get the main system name.
|
||||
(let* ((lisp-prefix (string-append lisp-type "-"))
|
||||
(package-name (hyphen-separated-name->name+version
|
||||
(if (string-prefix? lisp-prefix name)
|
||||
(string-drop name
|
||||
(string-length lisp-prefix))
|
||||
name))))
|
||||
`(quote ,(list package-name)))
|
||||
asd-systems))
|
||||
|
||||
(define builder
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
|
||||
;;; Copyright © 2020 Guillaume Le Vaillant <glv@posteo.net>
|
||||
;;; Copyright © 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -52,12 +52,13 @@ (define %system-install-prefix
|
|||
(string-append %source-install-prefix "/systems"))
|
||||
|
||||
(define (main-system-name output)
|
||||
(let ((package-name (package-name->name+version
|
||||
(strip-store-file-name output)))
|
||||
(lisp-prefix (string-append (%lisp-type) "-")))
|
||||
(if (string-prefix? lisp-prefix package-name)
|
||||
(string-drop package-name (string-length lisp-prefix))
|
||||
package-name)))
|
||||
;; FIXME: Find a more reliable way to get the main system name.
|
||||
(let* ((full-name (strip-store-file-name output))
|
||||
(lisp-prefix (string-append (%lisp-type) "-"))
|
||||
(package-name (if (string-prefix? lisp-prefix full-name)
|
||||
(string-drop full-name (string-length lisp-prefix))
|
||||
full-name)))
|
||||
(package-name->name+version package-name)))
|
||||
|
||||
(define (lisp-source-directory output name)
|
||||
(string-append output (%lisp-source-install-prefix) "/" name))
|
||||
|
|
Loading…
Reference in a new issue