branch wip-lisp updated: build-system: asdf: Improve install phase for CL source packages.

[guix-commits]

This is an automated email from the git hooks/post-receive script.

glv pushed a commit to branch wip-lisp
in repository guix.

The following commit(s) were added to refs/heads/wip-lisp by this push:
     new e0d9103  build-system: asdf: Improve install phase for CL source 
packages.
e0d9103 is described below

commit e0d9103f416d5c6e6c0c230f08dc9392bb8e8df1
Author: Guillaume Le Vaillant <glv@posteo.net>
AuthorDate: Tue Sep 15 22:00:29 2020 +0200

    build-system: asdf: Improve install phase for CL source packages.
    
    * guix/build/asdf-build-system.scm (install)[parent-source]: Add support for
      package names not containing a hyphen.
---
 guix/build/asdf-build-system.scm | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm
index 26d295e..6ad855c 100644
--- a/guix/build/asdf-build-system.scm
+++ b/guix/build/asdf-build-system.scm
@@ -124,9 +124,10 @@ if it's present in the native-inputs."
     (package-name->name+version
      (strip-store-file-name output)))
   (define (no-prefix pkgname)
-    (if (string-index pkgname #\-)
-        (string-drop pkgname (1+ (string-index pkgname #\-)))
-        pkgname))
+    (let ((index (string-index pkgname #\-)))
+      (if index
+          (string-drop pkgname (1+ index))
+          pkgname)))
   (define parent
     (match (assoc package-name inputs
                   (lambda (key alist-car)
@@ -142,8 +143,10 @@ if it's present in the native-inputs."
   (define parent-source
     (and parent
          (string-append parent "/share/common-lisp/"
-                        (string-take parent-name
-                                     (string-index parent-name #\-)))))
+                        (let ((index (string-index parent-name #\-)))
+                          (if index
+                              (string-take parent-name index)
+                              parent-name)))))
 
   (define (first-subdirectory directory) ; From gnu-build-system.
     "Return the file name of the first sub-directory of DIRECTORY."