~ruther/guix-local

be13fbfa83dd3e3c7a7a3d09f9c520940eb350d4 — Ludovic Courtès 13 years ago 3c0670e
Add (guix build-system trivial).

* guix/build-system/trivial.scm: New file.
* Makefile.am (MODULES): Add it.
* tests/packages.scm ("trivial"): New test.

* guix/packages.scm (package-derivation): Allow SOURCE to be #f.
4 files changed, 60 insertions(+), 2 deletions(-)

M Makefile.am
A guix/build-system/trivial.scm
M guix/packages.scm
M tests/packages.scm
M Makefile.am => Makefile.am +1 -0
@@ 23,6 23,7 @@ MODULES =					\
  guix/derivations.scm				\
  guix/build-system.scm				\
  guix/build-system/gnu.scm			\
  guix/build-system/trivial.scm			\
  guix/http.scm					\
  guix/store.scm				\
  guix/build/gnu-build-system.scm		\

A guix/build-system/trivial.scm => guix/build-system/trivial.scm +39 -0
@@ 0,0 1,39 @@
;;; 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-system trivial)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix derivations)
  #:use-module (guix build-system)
  #:export (trivial-build-system))

(define* (trivial-build store name source inputs
                        #:key outputs system builder (modules '()))
  "Run build expression BUILDER, an expression, for SYSTEM.  SOURCE is
ignored."
  (build-expression->derivation store name system builder inputs
                                #:outputs outputs
                                #:modules modules))

(define trivial-build-system
  (build-system (name 'trivial)
                (description
                 "Trivial build system, to run arbitrary Scheme build expressions")
                (build trivial-build)
                (cross-build trivial-build)))

M guix/packages.scm => guix/packages.scm +1 -1
@@ 261,7 261,7 @@ recursively."
           (cache package system
                  (apply builder
                         store (package-full-name package)
                         (package-source-derivation store source)
                         (and source (package-source-derivation store source))
                         inputs
                         #:outputs outputs #:system system
                         (if (procedure? args)

M tests/packages.scm => tests/packages.scm +19 -1
@@ 22,6 22,7 @@
  #:use-module (guix utils)
  #:use-module (guix derivations)
  #:use-module (guix packages)
  #:use-module (guix build-system trivial)
  #:use-module (guix build-system gnu)
  #:use-module (distro)
  #:use-module (distro base)


@@ 62,7 63,24 @@
                   ("d" ,d) ("d/x" "something.drv"))
                 (pk 'x (package-transitive-inputs e))))))

(test-skip (if (not %store) 1 0))
(test-skip (if (not %store) 2 0))

(test-assert "trivial"
  (let* ((p (package (inherit (dummy-package "trivial"))
              (build-system trivial-build-system)
              (source #f)
              (arguments
               '(#:builder
                 (begin
                   (mkdir %output)
                   (call-with-output-file (string-append %output "/test")
                     (lambda (p)
                       (display '(hello guix) p))))))))
         (d (package-derivation %store p)))
    (and (build-derivations %store (list d))
         (let ((p (pk 'drv d (derivation-path->output-path d))))
           (equal? '(hello guix)
                   (call-with-input-file (string-append p "/test") read))))))

(test-assert "GNU Hello"
  (and (package? hello)