me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2017-05-09 17:04:02 +02:00
parent 75c260ba5a
commit 838ba73d6e
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 103 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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)
;; Arrange so that our own (guix build …) modules are
;; used.
#:module-path (list (top-source-directory))))
;; 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))
#: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))