ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

build-system: asdf: Work around package-name->name+version bug.

Browse source 
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:
Guillaume Le Vaillant 2021-05-06 10:32:56 +02:00
parent e5adaf6c2d
commit 2fa8fd4af5
No known key found for this signature in database
GPG key ID: 6BE8208ADF21FE3F
2 changed files with 17 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
guix/build-system/asdf.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca> ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -291,16 +291,16 @@ (define (asdf-build lisp-type)
(imported-modules %asdf-build-system-modules) (imported-modules %asdf-build-system-modules)
(modules %asdf-build-modules)) (modules %asdf-build-modules))
;; FIXME: The definition of 'systems' is pretty hacky.
;; Is there a more elegant way to do it?
(define systems (define systems
(if (null? (cadr asd-systems)) (if (null? (cadr asd-systems))
`(quote ;; FIXME: Find a more reliable way to get the main system name.
,(list (let* ((lisp-prefix (string-append lisp-type "-"))
(string-drop (package-name (hyphen-separated-name->name+version
;; NAME is the value returned from `package-full-name'. (if (string-prefix? lisp-prefix name)
(hyphen-separated-name->name+version name) (string-drop name
(1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix. (string-length lisp-prefix))
name))))
`(quote ,(list package-name)))
asd-systems)) asd-systems))
(define builder (define builder

15
guix/build/asdf-build-system.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca> ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -52,12 +52,13 @@ (define %system-install-prefix
(string-append %source-install-prefix "/systems")) (string-append %source-install-prefix "/systems"))
(define (main-system-name output) (define (main-system-name output)
(let ((package-name (package-name->name+version ;; FIXME: Find a more reliable way to get the main system name.
(strip-store-file-name output))) (let* ((full-name (strip-store-file-name output))
(lisp-prefix (string-append (%lisp-type) "-"))) (lisp-prefix (string-append (%lisp-type) "-"))
(if (string-prefix? lisp-prefix package-name) (package-name (if (string-prefix? lisp-prefix full-name)
(string-drop package-name (string-length lisp-prefix)) (string-drop full-name (string-length lisp-prefix))
package-name))) full-name)))
(package-name->name+version package-name)))
(define (lisp-source-directory output name) (define (lisp-source-directory output name)
(string-append output (%lisp-source-install-prefix) "/" name)) (string-append output (%lisp-source-install-prefix) "/" name))