aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPierre Neidhardt <mail@ambrevar.xyz>2020-05-07 14:25:51 +0200
committerPierre Neidhardt <mail@ambrevar.xyz>2020-05-21 11:53:06 +0200
commitc3f1f09586967c3fefbb280014a4d46b57786696 (patch)
treedf9bec7343c29a2305390a8339ee91bcb137f1fe
parenta0828560b58f6b6c8b400caf0ceee396abc7d4c0 (diff)
downloadguix-c3f1f09586967c3fefbb280014a4d46b57786696.tar
guix-c3f1f09586967c3fefbb280014a4d46b57786696.tar.gz
build: asdf-build-system: Use SBCL source in CL packages.
* 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 above install phase.
-rw-r--r--guix/build-system/asdf.scm5
-rw-r--r--guix/build/asdf-build-system.scm54
2 files changed, 52 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..25dd031962 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,53 @@ 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 compile package (e.g. SBCL)
+if it's present in the native-inputs."
(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 pkgname)
+ (if (string-index pkgname #\-)
+ (string-drop pkgname (1+ (string-index pkgname #\-)))
+ pkgname))
+ (define parent
+ (match (assoc package-name inputs
+ (lambda (key alist-car)
+ (let* ((alt-key (no-prefix key))
+ (alist-car (no-prefix alist-car)))
+ (or (string=? alist-car key)
+ (string=? alist-car alt-key)))))
+ (#f #f)
+ (p (cdr p))))
+ (define parent-name
+ (and parent
+ (package-name->name+version (strip-store-file-name parent))))
+ (define parent-source
+ (and parent
+ (string-append parent "/share/common-lisp/"
+ (string-take parent-name
+ (string-index parent-name #\-))
+ "-source")))
+
+ (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 parent-source
+ (file-exists? parent-source))
+ (string-append parent-source "/" (first-subdirectory parent-source))
+ "."))
+
+ (with-directory-excursion source-directory
+ (copy-files-to-output output package-name)))
(define* (copy-source #:key outputs asd-system-name #:allow-other-keys)
"Copy the source to the library output."