guix-bioinformatics
/
guix
mirror of http://git.savannah.gnu.org/git/guix.git
3
0
Fork 0
Code Issues Projects Releases Wiki Activity
Browse Source

pull: Build with the matching Guile major version. 

Previously, 'guix pull' would always build with Guile 2.0.
Now it builds with the Guile that matches (effective-version).

* build-aux/build-self.scm (false-if-wrong-guile)
(package-for-current-guile): New procedures.
(guile-json, guile-ssh): Use it.
(guile-for-build): New procedure.
(build): Use (effective-version) instead of the hard-coded "/2.0".
Add (guix modules) closure to #:modules argument.  Pass
\#:guile-for-build argument to 'gexp->derivation'.
* guix/build/pull.scm (depends-on-guile-ssh?, all-scheme-files): New
procedures.
(build-guix): Show the output of (version).  Use the above procedures.
Filter out files that match 'depends-on-guile-ssh?' when (ssh session)
is missing.
version-0.13.0
Ludovic Courtès 5 years ago
parent
75c260ba5a
commit
838ba73d6e
No known key found for this signature in database GPG Key ID: 90B11993D9AEBB5
2 changed files with 103 additions and 29 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 88
      build-aux/build-self.scm
  2. 44
      guix/build/pull.scm

88
build-aux/build-self.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,6 +22,7 @@
#:use-module (guix config)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (ice-9 match)
#:export (build))
;;; Commentary:
@ -58,11 +59,43 @@
(define xz
(first (find-best-packages-by-name "xz" #f)))
(define (false-if-wrong-guile package)
"Return #f if PACKAGE depends on the \"wrong\" major version of Guile (e.g.,
2.0 instead of 2.2), otherwise return PACKAGE."
(let ((guile (any (match-lambda
((label (? package? dep) _ ...)
(and (string=? (package-name dep) "guile")
dep)))
(package-direct-inputs package))))
(and (or (not guile)
(string-prefix? (effective-version)
(package-version guile)))
package)))
(define (package-for-current-guile . names)
"Return the package with one of the given NAMES that depends on the current
Guile major version (2.0 or 2.2), or #f if none of the packages matches."
(let loop ((names names))
(match names
(()
#f)
((name rest ...)
(match (find-best-packages-by-name name #f)
(()
(loop rest))
((first _ ...)
(or (false-if-wrong-guile first)
(loop rest))))))))
(define guile-json
(first (find-best-packages-by-name "guile-json" #f)))
(package-for-current-guile "guile-json"
"guile2.2-json"
"guile2.0-json"))
(define guile-ssh
(first (find-best-packages-by-name "guile-ssh" #f)))
(package-for-current-guile "guile-ssh"
"guile2.2-ssh"
"guile2.0-ssh"))
;; The actual build procedure.
@ -80,6 +113,17 @@ person's version identifier."
;; XXX: Replace with a Git commit id.
(date->string (current-date 0) "~Y~m~d.~H"))
(define (guile-for-build)
"Return a derivation for Guile 2.0 or 2.2, whichever matches the currently
running Guile."
(package->derivation (cond-expand
(guile-2.2
(canonical-package
(specification->package "guile@2.2")))
(else
(canonical-package
(specification->package "guile@2.0"))))))
;; The procedure below is our return value.
(define* (build source
#:key verbose? (version (date-version-string))
@ -104,15 +148,19 @@ files."
#~(begin
(use-modules (guix build pull))
(let ((json (string-append #$guile-json "/share/guile/site/2.0")))
(let ((json (string-append #$guile-json "/share/guile/site/"
#$(effective-version))))
(set! %load-path
(cons* json
(string-append #$guile-ssh "/share/guile/site/2.0")
%load-path))
(cons* json
(string-append #$guile-ssh "/share/guile/site/"
#$(effective-version))
%load-path))
(set! %load-compiled-path
(cons* json
(string-append #$guile-ssh "/lib/guile/2.0/site-ccache")
%load-compiled-path)))
(cons* json
(string-append #$guile-ssh "/lib/guile/"
#$(effective-version)
"/site-ccache")
%load-compiled-path)))
;; XXX: The 'guile-ssh' package prior to Guix commit 92b7258 was
;; broken: libguile-ssh could not be found. Work around that.
@ -146,13 +194,21 @@ files."
(current-error-port)
(%make-void-port "w")))))
(gexp->derivation "guix-latest" builder
#:modules '((guix build pull)
(guix build utils))
(mlet %store-monad ((guile (guile-for-build)))
(gexp->derivation "guix-latest" builder
#:modules '((guix build pull)
(guix build utils)
;; Closure of (guix modules).
(guix modules)
(guix memoization)
(guix sets))
;; Arrange so that our own (guix build …) modules are
;; used.
#:module-path (list (top-source-directory))
;; Arrange so that our own (guix build …) modules are
;; used.
#:module-path (list (top-source-directory))))
#:guile-for-build guile)))
;; This file is loaded by 'guix pull'; return it the build procedure.
build

44
guix/build/pull.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;;
;;; This file is part of GNU Guix.
@ -18,6 +18,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build pull)
#:use-module (guix modules)
#:use-module (guix build utils)
#:use-module (system base compile)
#:use-module (ice-9 ftw)
@ -35,6 +36,27 @@
;;;
;;; Code:
(define (depends-on-guile-ssh? file)
"Return true if FILE is a Scheme source file that depends, directly or
indirectly, on Guile-SSH."
(find (match-lambda
(('ssh _ ...) #t)
(_ #f))
(source-module-closure file #:select? (const #t))))
(define (all-scheme-files directory)
"Return a sorted list of Scheme files found in DIRECTORY."
;; Load guix/ modules before gnu/ modules to get somewhat steadier
;; progress reporting.
(sort (filter (cut string-suffix? ".scm" <>)
(find-files directory "\\.scm"))
(let ((guix (string-append directory "/guix"))
(gnu (string-append directory "/gnu")))
(lambda (a b)
(or (and (string-prefix? guix a)
(string-prefix? gnu b))
(string<? a b))))))
(define* (build-guix out source
#:key
system
@ -55,7 +77,8 @@ containing the source code. Write any debugging output to DEBUG-PORT."
(setvbuf (current-error-port) _IOLBF)
(with-directory-excursion source
(format #t "copying and compiling to '~a'...~%" out)
(format #t "copying and compiling to '~a' with Guile ~a...~%"
out (version))
;; Copy everything under guix/ and gnu/ plus {guix,gnu}.scm.
(copy-recursively "guix" (string-append out "/guix")
@ -92,17 +115,12 @@ containing the source code. Write any debugging output to DEBUG-PORT."
;; Compile the .scm files. Load all the files before compiling them to
;; work around <http://bugs.gnu.org/15602> (FIXME).
(let* ((files
;; Load guix/ modules before gnu/ modules to get somewhat steadier
;; progress reporting.
(sort (filter (cut string-suffix? ".scm" <>)
(find-files out "\\.scm"))
(let ((guix (string-append out "/guix"))
(gnu (string-append out "/gnu")))
(lambda (a b)
(or (and (string-prefix? guix a)
(string-prefix? gnu b))
(string<? a b))))))
;; Filter out files depending on Guile-SSH when Guile-SSH is missing.
(let* ((files (remove (if (false-if-exception
(resolve-interface '(ssh session)))
(const #f)
depends-on-guile-ssh?)
(all-scheme-files out)))
(total (length files)))
(let loop ((files files)
(completed 0))

Write Preview
Loading…
Cancel
Save