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

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.
version-0.8.3
Ludovic Courtès 10 years ago
parent
bcdd83ec69
commit
c36db98c8e
5 changed files with 218 additions and 0 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. 79
      guix/build/gnu-build-system.scm
  2. 65
      guix/build/utils.scm
  3. 1
      guix/derivations.scm
  4. 61
      guix/gnu-build-system.scm
  5. 12
      tests/builders.scm

79
guix/build/gnu-build-system.scm
View File

@ -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"))

65
guix/build/utils.scm
View File

@ -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)))

1
guix/derivations.scm
View File

@ -482,6 +482,7 @@ INPUTS."
'(("HOME" . "/homeless"))
`((,(%guile-for-build))
(,builder)
,@(map (compose list cdr) inputs)
,@(if mod-drv `((,mod-drv)) '()))
#:hash hash #:hash-algo hash-algo
#:outputs outputs)))

61
guix/gnu-build-system.scm
View File

@ -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))))

12
tests/builders.scm
View File

@ -19,6 +19,7 @@
(define-module (test-builders)
#:use-module (guix http)
#:use-module (guix gnu-build-system)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
@ -40,6 +41,17 @@
(and (build-derivations %store (list 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")

Write Preview
Loading…
Cancel
Save