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

+ 79
- 0
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
- 0
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
- 0
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
- 0
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
- 0
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")


Loading…
Cancel
Save