Add supporting tools for the GNU Build System.
* guix/derivations.scm (build-expression->derivation): Add all of INPUTS
as inputs to the final derivation.
* guix/build/gnu-build-system.scm, guix/build/utils.scm,
guix/gnu-build-system.scm: New files.
* tests/builders.scm ("gnu-build"): New test.
This commit is contained in:
Ludovic Courtès
parent
bcdd83ec69
commit
c36db98c8e
|
|
@ -0,0 +1,79 @@
|
||||||
|
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
|
||||||
|
;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of Guix.
|
||||||
|
;;;
|
||||||
|
;;; Guix is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; Guix is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (guix build gnu-build-system)
|
||||||
|
#:use-module (guix build utils)
|
||||||
|
#:use-module (ice-9 ftw)
|
||||||
|
#:export (gnu-build))
|
||||||
|
|
||||||
|
;; Commentary:
|
||||||
|
;;
|
||||||
|
;; Standard build procedure for packages using the GNU Build System or
|
||||||
|
;; something compatible ("./configure && make && make install"). This is the
|
||||||
|
;; builder-side code.
|
||||||
|
;;
|
||||||
|
;; Code:
|
||||||
|
|
||||||
|
(define (first-subdirectory dir)
|
||||||
|
"Return the path of the first sub-directory of DIR."
|
||||||
|
(file-system-fold (lambda (path stat result)
|
||||||
|
(string=? path dir))
|
||||||
|
(lambda (path stat result) result) ; leaf
|
||||||
|
(lambda (path stat result) result) ; down
|
||||||
|
(lambda (path stat result) result) ; up
|
||||||
|
(lambda (path stat result) ; skip
|
||||||
|
(or result path))
|
||||||
|
(lambda (path stat errno result) ; error
|
||||||
|
(error "first-subdirectory" (strerror errno)))
|
||||||
|
#f
|
||||||
|
dir))
|
||||||
|
|
||||||
|
(define (unpack source)
|
||||||
|
(system* "tar" "xvf" source)
|
||||||
|
(chdir (first-subdirectory ".")))
|
||||||
|
|
||||||
|
(define (configure outputs flags)
|
||||||
|
(let ((prefix (assoc-ref outputs "out"))
|
||||||
|
(libdir (assoc-ref outputs "lib"))
|
||||||
|
(includedir (assoc-ref outputs "include")))
|
||||||
|
(apply system* "./configure"
|
||||||
|
"--enable-fast-install"
|
||||||
|
(string-append "--prefix=" prefix)
|
||||||
|
`(,@(if libdir
|
||||||
|
(list (string-append "--libdir=" libdir))
|
||||||
|
'())
|
||||||
|
,@(if includedir
|
||||||
|
(list (string-append "--includedir=" includedir))
|
||||||
|
'())
|
||||||
|
,@flags))))
|
||||||
|
|
||||||
|
(define* (gnu-build source outputs inputs
|
||||||
|
#:key (configure-flags '()))
|
||||||
|
"Build from SOURCE to OUTPUTS, using INPUTS."
|
||||||
|
(let ((inputs (map cdr inputs)))
|
||||||
|
(set-path-environment-variable "PATH" '("bin") inputs)
|
||||||
|
(set-path-environment-variable "CPATH" '("include") inputs)
|
||||||
|
(set-path-environment-variable "LIBRARY_PATH" '("lib" "lib64") inputs))
|
||||||
|
(pk (getenv "PATH"))
|
||||||
|
(pk 'inputs inputs)
|
||||||
|
(system* "ls" "/nix/store")
|
||||||
|
(unpack source)
|
||||||
|
(configure outputs configure-flags)
|
||||||
|
(system* "make")
|
||||||
|
(system* "make" "check")
|
||||||
|
(system* "make" "install"))
|
||||||
|
|
@ -0,0 +1,65 @@
|
||||||
|
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
|
||||||
|
;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of Guix.
|
||||||
|
;;;
|
||||||
|
;;; Guix is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; Guix is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (guix build utils)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
|
#:export (directory-exists?
|
||||||
|
set-path-environment-variable))
|
||||||
|
|
||||||
|
(define (directory-exists? dir)
|
||||||
|
"Return #t if DIR exists and is a directory."
|
||||||
|
(pk 'dir-exists? dir
|
||||||
|
(let ((s (pk 'stat dir (stat dir #f))))
|
||||||
|
(and s
|
||||||
|
(eq? 'directory (stat:type s))))))
|
||||||
|
|
||||||
|
(define (search-path-as-list sub-directories input-dirs)
|
||||||
|
"Return the list of directories among SUB-DIRECTORIES that exist in
|
||||||
|
INPUT-DIRS. Example:
|
||||||
|
|
||||||
|
(search-path-as-list '(\"share/emacs/site-lisp\" \"share/emacs/24.1\")
|
||||||
|
(list \"/package1\" \"/package2\" \"/package3\"))
|
||||||
|
=> (\"/package1/share/emacs/site-lisp\"
|
||||||
|
\"/package3/share/emacs/site-lisp\")
|
||||||
|
|
||||||
|
"
|
||||||
|
(append-map (lambda (input)
|
||||||
|
(filter-map (lambda (dir)
|
||||||
|
(let ((dir (string-append input "/"
|
||||||
|
dir)))
|
||||||
|
(and (directory-exists? dir)
|
||||||
|
dir)))
|
||||||
|
sub-directories))
|
||||||
|
input-dirs))
|
||||||
|
|
||||||
|
(define (list->search-path-as-string lst separator)
|
||||||
|
(string-join lst separator))
|
||||||
|
|
||||||
|
(define* (set-path-environment-variable env-var sub-directories input-dirs
|
||||||
|
#:key (separator ":"))
|
||||||
|
"Look for each of SUB-DIRECTORIES in INPUT-DIRS. Set ENV-VAR to a
|
||||||
|
SEPARATOR-separated path accordingly. Example:
|
||||||
|
|
||||||
|
(set-path-environment-variable \"PKG_CONFIG\"
|
||||||
|
'(\"lib/pkgconfig\")
|
||||||
|
(list package1 package2))
|
||||||
|
"
|
||||||
|
(setenv env-var
|
||||||
|
(list->search-path-as-string (search-path-as-list sub-directories
|
||||||
|
input-dirs)
|
||||||
|
separator)))
|
||||||
|
|
@ -482,6 +482,7 @@ INPUTS."
|
||||||
'(("HOME" . "/homeless"))
|
'(("HOME" . "/homeless"))
|
||||||
`((,(%guile-for-build))
|
`((,(%guile-for-build))
|
||||||
(,builder)
|
(,builder)
|
||||||
|
,@(map (compose list cdr) inputs)
|
||||||
,@(if mod-drv `((,mod-drv)) '()))
|
,@(if mod-drv `((,mod-drv)) '()))
|
||||||
#:hash hash #:hash-algo hash-algo
|
#:hash hash #:hash-algo hash-algo
|
||||||
#:outputs outputs)))
|
#:outputs outputs)))
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,61 @@
|
||||||
|
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
|
||||||
|
;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of Guix.
|
||||||
|
;;;
|
||||||
|
;;; Guix is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; Guix is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (guix gnu-build-system)
|
||||||
|
#:use-module (guix store)
|
||||||
|
#:use-module (guix utils)
|
||||||
|
#:use-module (guix derivations)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
|
#:export (gnu-build))
|
||||||
|
|
||||||
|
;; Commentary:
|
||||||
|
;;
|
||||||
|
;; Standard build procedure for packages using the GNU Build System or
|
||||||
|
;; something compatible ("./configure && make && make install").
|
||||||
|
;;
|
||||||
|
;; Code:
|
||||||
|
|
||||||
|
(define %standard-inputs
|
||||||
|
(map (lambda (name)
|
||||||
|
(cons name (nixpkgs-derivation name)))
|
||||||
|
'("gnutar" "gzip" "bzip2" "xz"
|
||||||
|
"coreutils" "gnused" "gnugrep" "bash"
|
||||||
|
"gcc" "binutils" "gnumake" "glibc")))
|
||||||
|
|
||||||
|
(define* (gnu-build store name source inputs
|
||||||
|
#:key (outputs '("out")) (configure-flags '())
|
||||||
|
(system (%current-system)))
|
||||||
|
"Return a derivation called NAME that builds from tarball SOURCE, with
|
||||||
|
input derivation INPUTS, using the usual procedure of the GNU Build System."
|
||||||
|
(define builder
|
||||||
|
`(begin
|
||||||
|
(use-modules (guix build gnu-build-system))
|
||||||
|
(gnu-build ,(if (derivation-path? source)
|
||||||
|
(derivation-path->output-path source)
|
||||||
|
source)
|
||||||
|
%outputs
|
||||||
|
%build-inputs
|
||||||
|
#:configure-flags ',configure-flags)))
|
||||||
|
|
||||||
|
(build-expression->derivation store name system
|
||||||
|
builder
|
||||||
|
(alist-cons "source" source
|
||||||
|
(append inputs %standard-inputs))
|
||||||
|
#:outputs outputs
|
||||||
|
#:modules '((guix build gnu-build-system)
|
||||||
|
(guix build utils))))
|
||||||
|
|
@ -19,6 +19,7 @@
|
||||||
|
|
||||||
(define-module (test-builders)
|
(define-module (test-builders)
|
||||||
#:use-module (guix http)
|
#:use-module (guix http)
|
||||||
|
#:use-module (guix gnu-build-system)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
|
|
@ -40,6 +41,17 @@
|
||||||
(and (build-derivations %store (list drv-path))
|
(and (build-derivations %store (list drv-path))
|
||||||
(file-exists? (derivation-path->output-path drv-path)))))
|
(file-exists? (derivation-path->output-path drv-path)))))
|
||||||
|
|
||||||
|
(test-assert "gnu-build"
|
||||||
|
(let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")
|
||||||
|
(hash (nix-base32-string->bytevector
|
||||||
|
"0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
|
||||||
|
(tarball (http-fetch %store url 'sha256 hash))
|
||||||
|
(build (gnu-build %store "hello-2.8" tarball
|
||||||
|
`(("gawk" . ,(nixpkgs-derivation "gawk"))))))
|
||||||
|
(and (build-derivations %store (list (pk 'hello-drv build)))
|
||||||
|
(file-exists? (string-append (derivation-path->output-path build)
|
||||||
|
"/bin/hello")))))
|
||||||
|
|
||||||
(test-end "builders")
|
(test-end "builders")
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue