build-system: Add 'meson-build-system'.

* Makefile.am (MODULES): Add 'guix/build-system/meson.scm' and
'guix/build/meson-build-system.scm'.
* guix/build-system/meson.scm: New file.
* guix/build/meson-build-system.scm: New file.
* doc/guix.texi (Build Systems): Add 'meson-build-system'.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Peter Mikkelsen 2017-09-13 14:37:39 +02:00 committed by Ludovic Courtès
parent 3f0de257c4
commit 07c101e221
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 385 additions and 0 deletions

View File

@ -79,6 +79,7 @@ MODULES = \
guix/build-system/dub.scm \
guix/build-system/emacs.scm \
guix/build-system/font.scm \
guix/build-system/meson.scm \
guix/build-system/minify.scm \
guix/build-system/asdf.scm \
guix/build-system/glib-or-gtk.scm \
@ -106,6 +107,7 @@ MODULES = \
guix/build/cmake-build-system.scm \
guix/build/dub-build-system.scm \
guix/build/emacs-build-system.scm \
guix/build/meson-build-system.scm \
guix/build/minify-build-system.scm \
guix/build/font-build-system.scm \
guix/build/asdf-build-system.scm \

View File

@ -3811,6 +3811,61 @@ need to be copied into place. It copies font files to standard
locations in the output directory.
@end defvr
@defvr {Scheme Variable} meson-build-system
This variable is exported by @code{(guix build-system meson)}. It
implements the build procedure for packages that use
@url{http://mesonbuild.com, Meson} as their build system.
It adds both Meson and @uref{https://ninja-build.org/, Ninja} to the set
of inputs, and they can be changed with the parameters @code{#:meson}
and @code{#:ninja} if needed. The default Meson is
@code{meson-for-build}, which is special because it doesn't clear the
@code{RUNPATH} of binaries and libraries when they are installed.
This build system is an extension of @var{gnu-build-system}, but with the
following phases changed to some specific for Meson:
@table @code
@item configure
The phase runs @code{meson} with the flags specified in
@code{#:configure-flags}. The flag @code{--build-type} is always set to
@code{plain} unless something else is specified in @code{#:build-type}.
@item build
The phase runs @code{ninja} to build the package in parallel by default, but
this can be changed with @code{#:parallel-build?}.
@item check
The phase runs @code{ninja} with the target specified in @code{#:test-target},
which is @code{"test"} by default.
@item install
The phase runs @code{ninja install} and can not be changed.
@end table
Apart from that, the build system also adds the following phases:
@table @code
@item fix-runpath
This phase tries to locate the local directories in the package being build,
which has libraries that some of the binaries need. If any are found, they will
be added to the programs @code{RUNPATH}. It is needed because
@code{meson-for-build} keeps the @code{RUNPATH} of binaries and libraries from
when they are build, but often that is not the @code{RUNPATH} we want.
Therefor it is also shrinked to the minimum needed by the program.
@item glib-or-gtk-wrap
This phase is the phase provided by @code{glib-or-gtk-build-system}, and it
is not enabled by default. It can be enabled with @code{#:glib-or-gtk?}.
@item glib-or-gtk-compile-schemas
This phase is the phase provided by @code{glib-or-gtk-build-system}, and it
is not enabled by default. It can be enabled with @code{#:glib-or-gtk?}.
@end table
@end defvr
Lastly, for packages that do not need anything as sophisticated, a
``trivial'' build system is provided. It is trivial in the sense that
it provides basically no support: it does not pull any implicit inputs,

178
guix/build-system/meson.scm Normal file
View File

@ -0,0 +1,178 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
;;;
;;; 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-system meson)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (guix build-system glib-or-gtk)
#:use-module (guix packages)
#:use-module (ice-9 match)
#:export (%meson-build-system-modules
meson-build-system))
;; Commentary:
;;
;; Standard build procedure for packages using Meson. This is implemented as an
;; extension of `gnu-build-system', with the option to turn on the glib/gtk
;; phases from `glib-or-gtk-build-system'.
;;
;; Code:
(define %meson-build-system-modules
;; Build-side modules imported by default.
`((guix build meson-build-system)
(guix build rpath)
;; The modules from glib-or-gtk contains the modules from gnu-build-system,
;; so there is no need to import that too.
,@%glib-or-gtk-build-system-modules))
(define (default-ninja)
"Return the default ninja package."
;; Lazily resolve the binding to avoid a circular dependency.
(let ((module (resolve-interface '(gnu packages ninja))))
(module-ref module 'ninja)))
(define (default-meson)
"Return the default meson package."
;; Lazily resolve the binding to avoid a circular dependency.
(let ((module (resolve-interface '(gnu packages build-tools))))
(module-ref module 'meson-for-build)))
(define (default-patchelf)
"Return the default patchelf package."
;; Lazily resolve the binding to avoid a circular dependency.
(let ((module (resolve-interface '(gnu packages elf))))
(module-ref module 'patchelf)))
(define* (lower name
#:key source inputs native-inputs outputs system target
(meson (default-meson))
(ninja (default-ninja))
(glib-or-gtk #f)
#:allow-other-keys
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
`(#:source #:meson #:ninja #:inputs #:native-inputs #:outputs #:target))
(and (not target) ;; TODO: add support for cross-compilation.
(bag
(name name)
(system system)
(build-inputs `(("meson" ,meson)
("ninja" ,ninja)
;; Add patchelf for (guix build rpath) to work.
("patchelf" ,(default-patchelf))
,@native-inputs))
(host-inputs `(,@(if source
`(("source" ,source))
'())
,@inputs
;; Keep the standard inputs of 'gnu-build-system'.
,@(standard-packages)))
(outputs outputs)
(build meson-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (meson-build store name inputs
#:key (guile #f)
(outputs '("out"))
(configure-flags ''())
(search-paths '())
(build-type "plain")
(tests? #t)
(test-target "test")
(glib-or-gtk? #f)
(parallel-build? #t)
(parallel-tests? #f)
(validate-runpath? #t)
(patch-shebangs? #t)
(strip-binaries? #t)
(strip-flags ''("--strip-debug"))
(strip-directories ''("lib" "lib64" "libexec"
"bin" "sbin"))
(elf-directories ''("lib" "lib64" "libexec"
"bin" "sbin"))
(phases '(@ (guix build meson-build-system)
%standard-phases))
(system (%current-system))
(imported-modules %meson-build-system-modules)
(modules '((guix build meson-build-system)
(guix build utils))))
"Build SOURCE using MESON, and with INPUTS, assuming that SOURCE
has a 'meson.build' file."
(define builder
`(let ((build-phases (if ,glib-or-gtk?
,phases
(modify-phases ,phases
(delete 'glib-or-gtk-compile-schemas)
(delete 'glib-or-gtk-wrap)))))
(use-modules ,@modules)
(meson-build #:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases build-phases
#:configure-flags ,configure-flags
#:build-type ,build-type
#:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:validate-runpath? ,validate-runpath?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories
#:elf-directories ,elf-directories)))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build))
(define meson-build-system
(build-system
(name 'meson)
(description "The standard Meson build system")
(lower lower)))
;;; meson.scm ends here

View File

@ -0,0 +1,150 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
;;;
;;; 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 meson-build-system)
#:use-module ((guix build gnu-build-system) #:prefix gnu:)
#:use-module ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:)
#:use-module (guix build utils)
#:use-module (guix build rpath)
#:use-module (guix build gremlin)
#:use-module (guix elf)
#:use-module (ice-9 match)
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
#:export (%standard-phases
meson-build))
;; Commentary:
;;
;; Builder-side code of the standard meson build procedure.
;;
;; Code:
(define* (configure #:key outputs configure-flags build-type
#:allow-other-keys)
"Configure the given package."
(let* ((out (assoc-ref outputs "out"))
(source-dir (getcwd))
(build-dir "../build")
(prefix (assoc-ref outputs "out"))
(args `(,(string-append "--prefix=" prefix)
,(string-append "--buildtype=" build-type)
,@configure-flags
,source-dir)))
(mkdir build-dir)
(chdir build-dir)
(zero? (apply system* "meson" args))))
(define* (build #:key parallel-build?
#:allow-other-keys)
"Build a given meson package."
(zero? (apply system* "ninja"
(if parallel-build?
`("-j" ,(number->string (parallel-job-count)))
'("-j" "1")))))
(define* (check #:key test-target parallel-tests? tests?
#:allow-other-keys)
(setenv "MESON_TESTTHREADS"
(if parallel-tests?
(number->string (parallel-job-count))
"1"))
(if tests?
(zero? (system* "ninja" test-target))
(begin
(format #t "test suite not run~%")
#t)))
(define* (install #:rest args)
(zero? (system* "ninja" "install")))
(define* (fix-runpath #:key (elf-directories '("lib" "lib64" "libexec"
"bin" "sbin"))
outputs #:allow-other-keys)
"Try to make sure all ELF files in ELF-DIRECTORIES are able to find their
local dependencies in their RUNPATH, by searching for the needed libraries in
the directories of the package, and adding them to the RUNPATH if needed.
Also shrink the RUNPATH to what is needed,
since a lot of directories are left over from the build phase of meson,
for example libraries only needed for the tests."
;; Find the directories (if any) that contains DEP-NAME. The directories
;; searched are the ones that ELF-FILES are in.
(define (find-deps dep-name elf-files)
(map dirname (filter (lambda (file)
(string=? dep-name (basename file)))
elf-files)))
;; Return a list of libraries that FILE needs.
(define (file-needed file)
(let* ((elf (call-with-input-file file
(compose parse-elf get-bytevector-all)))
(dyninfo (elf-dynamic-info elf)))
(if dyninfo
(elf-dynamic-info-needed dyninfo)
'())))
;; If FILE needs any libs that are part of ELF-FILES, the RUNPATH
;; is modified accordingly.
(define (handle-file file elf-files)
(let* ((dep-dirs (concatenate (map (lambda (dep-name)
(find-deps dep-name elf-files))
(file-needed file)))))
(unless (null? dep-dirs)
(augment-rpath file (string-join dep-dirs ":")))))
(define handle-output
(match-lambda
((output . directory)
(let* ((elf-dirnames (map (lambda (subdir)
(string-append directory "/" subdir))
elf-directories))
(existing-elf-dirs (filter (lambda (dir)
(and (file-exists? dir)
(file-is-directory? dir)))
elf-dirnames))
(elf-pred (lambda (name stat)
(elf-file? name)))
(elf-list (concatenate (map (lambda (dir)
(find-files dir elf-pred))
existing-elf-dirs))))
(for-each (lambda (elf-file)
(system* "patchelf" "--shrink-rpath" elf-file)
(handle-file elf-file elf-list))
elf-list)))))
(for-each handle-output outputs)
#t)
(define %standard-phases
;; The standard-phases of glib-or-gtk contains a superset of the phases
;; from the gnu-build-system. If the glib-or-gtk? key is #f (the default)
;; then the extra phases will be removed again in (guix build-system meson).
(modify-phases glib-or-gtk:%standard-phases
(replace 'configure configure)
(replace 'build build)
(replace 'check check)
(replace 'install install)
(add-after 'strip 'fix-runpath fix-runpath)))
(define* (meson-build #:key inputs phases
#:allow-other-keys #:rest args)
"Build the given package, applying all of PHASES in order."
(apply gnu:gnu-build #:inputs inputs #:phases phases args))
;;; meson-build-system.scm ends here