GNU bug report logs - #41135
[PATCH 1/3] build: asdf-build-system: Use SBCL source in CL packages.

Previous Next

Full log

View this message in rfc822 format

From: Pierre Neidhardt <mail <at> ambrevar.xyz>
To: 41135 <at> debbugs.gnu.org
Subject: [bug#41135] [Patch v2 1/4] build: asdf-build-system: Use SBCL source in CL packages.
Date: Fri,  8 May 2020 12:37:11 +0200

* guix/build/asdf-build-system.scm (copy-files-to-output): Don't attempt to
  reset timestamps on files without write access.
  (install): When parent SBCL package is in the inputs, use its source.  This
  way we get possibly patched sources in CL packages as well (e.g. for FFI).
  This is also useful for sources that generate files on load-op, like cl-unicode.

* guix/build-system/asdf.scm (package-with-build-system): Forward the SBCL
  parent as a native input so that it can be used in the install phase above.
---
 guix/build-system/asdf.scm       |  5 +++-
 guix/build/asdf-build-system.scm | 40 +++++++++++++++++++++++++++-----
 2 files changed, 38 insertions(+), 7 deletions(-)

diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm
index f794bf006b..630b99e2bf 100644
--- a/guix/build-system/asdf.scm
+++ b/guix/build-system/asdf.scm
@@ -230,7 +230,10 @@ set up using CL source package conventions."
              ((#:phases phases) (list phases-transformer phases))))
           (inputs (new-inputs package-inputs))
           (propagated-inputs (new-propagated-inputs))
-          (native-inputs (new-inputs package-native-inputs))
+          (native-inputs (append (if target-is-source?
+                                     (list (list (package-name pkg) pkg))
+                                     '())
+                                 (new-inputs package-native-inputs)))
           (outputs (if target-is-source?
                        '("out")
                        (package-outputs pkg)))))
diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm
index f3f4b49bcf..158d351d1a 100644
--- a/guix/build/asdf-build-system.scm
+++ b/guix/build/asdf-build-system.scm
@@ -85,7 +85,8 @@ valid."
     ;; files before compiling.
     (for-each (lambda (file)
                 (let ((s (lstat file)))
-                  (unless (eq? (stat:type s) 'symlink)
+                  (unless (or (eq? (stat:type s) 'symlink)
+                              (not (access? file W_OK)))
                     (utime file 0 0 0 0))))
               (find-files source #:directories? #t))
     (copy-recursively source target #:keep-mtime? #t)
@@ -97,12 +98,39 @@ valid."
      (find-files target "\\.asd$"))
     #t))
 
-(define* (install #:key outputs #:allow-other-keys)
-  "Copy and symlink all the source files."
+(define* (install #:key inputs outputs #:allow-other-keys)
+  "Copy and symlink all the source files.
+The source files are taken from the corresponding SBCL package if it's present
+in the native-inputs."
+  ;; TODO: Use lisp-type instead of hardcoding SBCL.
   (define output (assoc-ref outputs "out"))
-  (copy-files-to-output output
-                        (package-name->name+version
-                         (strip-store-file-name output))))
+  (define package-name
+    (package-name->name+version
+     (strip-store-file-name output)))
+  (define no-prefix-name (string-drop package-name (string-length "cl-")))
+  (define sbcl-source (or (assoc-ref inputs (string-append "sbcl-" no-prefix-name))
+                          (assoc-ref inputs (string-append "sbcl-" package-name))))
+
+  (define (first-subdirectory directory) ; From gnu-build-system.
+    "Return the file name of the first sub-directory of DIRECTORY."
+    (match (scandir directory
+                    (lambda (file)
+                      (and (not (member file '("." "..")))
+                           (file-is-directory? (string-append directory "/"
+                                                              file)))))
+      ((first . _) first)))
+
+  (define source-directory
+    (if (and sbcl-source
+             (file-exists?
+              (string-append sbcl-source "/share/common-lisp/sbcl-source/")))
+        (let ((source (string-append sbcl-source "/share/common-lisp/sbcl-source/")))
+          (string-append source (first-subdirectory source)))
+        "."))
+  (with-directory-excursion source-directory
+    (copy-files-to-output output
+                          (package-name->name+version
+                           (strip-store-file-name output)))))
 
 (define* (copy-source #:key outputs asd-system-name #:allow-other-keys)
   "Copy the source to the library output."
-- 
2.25.1

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.