mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
build-system/gnu: Add `dist-package'.
* guix/build/gnu-dist.scm: New file. * Makefile.am (MODULES): Add it. * guix/build-system/gnu.scm (%default-modules): New variable. (gnu-build): Use it. (dist-package): New procedure.
This commit is contained in:
Ludovic Courtès
parent
7357138bba
commit
fe12c3458c
3 changed files with 137 additions and 5 deletions
|
|
@ -60,6 +60,7 @@ MODULES = \
|
|||
guix/build/download.scm \
|
||||
guix/build/cmake-build-system.scm \
|
||||
guix/build/gnu-build-system.scm \
|
||||
guix/build/gnu-dist.scm \
|
||||
guix/build/perl-build-system.scm \
|
||||
guix/build/python-build-system.scm \
|
||||
guix/build/utils.scm \
|
||||
|
|
|
|||
|
|
@ -32,7 +32,8 @@ (define-module (guix build-system gnu)
|
|||
package-with-explicit-inputs
|
||||
package-with-extra-configure-variable
|
||||
static-libgcc-package
|
||||
static-package))
|
||||
static-package
|
||||
dist-package))
|
||||
|
||||
;; Commentary:
|
||||
;;
|
||||
|
|
@ -41,6 +42,11 @@ (define-module (guix build-system gnu)
|
|||
;;
|
||||
;; Code:
|
||||
|
||||
(define %default-modules
|
||||
;; Build-side modules imported and used by default.
|
||||
'((guix build gnu-build-system)
|
||||
(guix build utils)))
|
||||
|
||||
(define* (package-with-explicit-inputs p inputs
|
||||
#:optional
|
||||
(loc (current-source-location))
|
||||
|
|
@ -152,6 +158,38 @@ (define* (static-package p #:optional (loc (current-source-location))
|
|||
''("--strip-all")
|
||||
flags)))))))
|
||||
|
||||
(define* (dist-package p source)
|
||||
"Return a package that runs takes source files from the SOURCE directory,
|
||||
runs `make distcheck' and whose result is one or more source tarballs."
|
||||
(let ((s source))
|
||||
(package (inherit p)
|
||||
(name (string-append (package-name p) "-dist"))
|
||||
(source s)
|
||||
(arguments
|
||||
;; Use the right phases and modules.
|
||||
(let* ((args (default-keyword-arguments (package-arguments p)
|
||||
`(#:phases #f
|
||||
#:modules ,%default-modules
|
||||
#:imported-modules ,%default-modules))))
|
||||
(substitute-keyword-arguments args
|
||||
((#:modules modules)
|
||||
`((guix build gnu-dist)
|
||||
,@modules))
|
||||
((#:imported-modules modules)
|
||||
`((guix build gnu-dist)
|
||||
,@modules))
|
||||
((#:phases _)
|
||||
'%dist-phases))))
|
||||
(native-inputs
|
||||
;; Add autotools & co. as inputs.
|
||||
(let ((ref (lambda (module var)
|
||||
(module-ref (resolve-interface module) var))))
|
||||
`(("autoconf" ,(ref '(gnu packages autotools) 'autoconf))
|
||||
("automake" ,(ref '(gnu packages autotools) 'automake))
|
||||
("libtool" ,(ref '(gnu packages autotools) 'libtool) "bin")
|
||||
("gettext" ,(ref '(gnu packages gettext) 'gettext))
|
||||
("texinfo" ,(ref '(gnu packages texinfo) 'texinfo))))))))
|
||||
|
||||
|
||||
(define %store
|
||||
;; Store passed to STANDARD-INPUTS.
|
||||
|
|
@ -227,10 +265,8 @@ (define* (gnu-build store name source inputs
|
|||
(phases '%standard-phases)
|
||||
(system (%current-system))
|
||||
(implicit-inputs? #t) ; useful when bootstrapping
|
||||
(imported-modules '((guix build gnu-build-system)
|
||||
(guix build utils)))
|
||||
(modules '((guix build gnu-build-system)
|
||||
(guix build utils))))
|
||||
(imported-modules %default-modules)
|
||||
(modules %default-modules))
|
||||
"Return a derivation called NAME that builds from tarball SOURCE, with
|
||||
input derivation INPUTS, using the usual procedure of the GNU Build
|
||||
System. The builder is run with GUILE, or with the distro's final Guile
|
||||
|
|
|
|||
95
guix/build/gnu-dist.scm
Normal file
95
guix/build/gnu-dist.scm
Normal file
|
|
@ -0,0 +1,95 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU 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.
|
||||
;;;
|
||||
;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (guix build gnu-dist)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (guix build gnu-build-system)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:export (%dist-phases))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; Build phases to build a source tarball with the GNU build system, as with
|
||||
;;; "make distcheck".
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define* (copy-source #:key source #:allow-other-keys)
|
||||
(copy-recursively source "."))
|
||||
|
||||
(define* (autoreconf #:rest args)
|
||||
(letrec-syntax ((try-files (syntax-rules (else)
|
||||
((_ (else fallback ...))
|
||||
(begin fallback ...))
|
||||
((_ file files ... (else fallback ...))
|
||||
(if (file-exists? file)
|
||||
(begin
|
||||
(format #t "bootstrapping with `~a'...~%"
|
||||
file)
|
||||
(zero?
|
||||
(system* (string-append "./" file))))
|
||||
(try-files files ...
|
||||
(else fallback ...)))))))
|
||||
(try-files "bootstrap" "bootstrap.sh" "autogen" "autogen.sh"
|
||||
(else
|
||||
(format #t "bootstrapping with `autoreconf'...~%")
|
||||
(zero? (system* "autoreconf" "-vfi"))))))
|
||||
|
||||
(define* (build #:key build-before-dist? make-flags (dist-target "distcheck")
|
||||
#:allow-other-keys
|
||||
#:rest args)
|
||||
(and (or (not build-before-dist?)
|
||||
(let ((build (assq-ref %standard-phases 'build)))
|
||||
(apply build args)))
|
||||
(begin
|
||||
(format #t "building target `~a'~%" dist-target)
|
||||
(zero? (apply system* "make" dist-target make-flags)))))
|
||||
|
||||
(define* (install-dist #:key outputs #:allow-other-keys)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
(meta (string-append out "/nix-support")) ; Hydra meta-data
|
||||
(tarballs (find-files "." "\\.tar\\.")))
|
||||
(mkdir out)
|
||||
(for-each (lambda (tarball)
|
||||
(copy-file tarball (string-append out "/" tarball)))
|
||||
out)
|
||||
|
||||
(mkdir meta)
|
||||
(call-with-output-file (string-append out "/hydra-build-products")
|
||||
(lambda (port)
|
||||
(for-each (lambda (tarball)
|
||||
;; This tells Hydra's what kind of build products we have,
|
||||
;; so it can represent them nicely. See `product-list.tt'
|
||||
;; in Hydra for details.
|
||||
(format port "file source-dist ~a/~a~%" out tarball))
|
||||
tarballs)))
|
||||
#t))
|
||||
|
||||
(define %dist-phases
|
||||
;; Phases for building a source tarball.
|
||||
(alist-replace
|
||||
'unpack copy-source
|
||||
(alist-cons-before
|
||||
'configure 'autoreconf autoreconf
|
||||
(alist-replace
|
||||
'build build
|
||||
(alist-replace
|
||||
'install install-dist
|
||||
(alist-delete 'strip %standard-phases))))))
|
||||
|
||||
;;; gnu-dist.scm ends here
|
||||
Loading…
Reference in a new issue