guix/build/meson-build-system.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
   3 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
   4 ;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (guix build meson-build-system)
  22   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
  23   #:use-module ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:)
  24   #:use-module (guix build utils)
  25   #:use-module (guix build gremlin)
  26   #:use-module (guix elf)
  27   #:use-module (ice-9 match)
  28   #:use-module (rnrs io ports)
  29   #:use-module (srfi srfi-1)
  30   #:export (%standard-phases
  31             meson-build))
  32
  33 ;; Commentary:
  34 ;;
  35 ;; Builder-side code of the standard meson build procedure.
  36 ;;
  37 ;; Code:
  38
  39 (define* (configure #:key outputs configure-flags build-type
  40                     #:allow-other-keys)
  41   "Configure the given package."
  42   (let* ((out (assoc-ref outputs "out"))
  43          (source-dir (getcwd))
  44          (build-dir "../build")
  45          (prefix (assoc-ref outputs "out"))
  46          (args `(,(string-append "--prefix=" prefix)
  47                  ,(string-append "--buildtype=" build-type)
  48                  ,(string-append "-Dc_link_args=-Wl,-rpath="
  49                                  (assoc-ref outputs "out") "/lib")
  50                  ,(string-append "-Dcpp_link_args=-Wl,-rpath="
  51                                  (assoc-ref outputs "out") "/lib")
  52                  ,@configure-flags
  53                  ,source-dir)))
  54
  55     (mkdir build-dir)
  56     (chdir build-dir)
  57     (apply invoke "meson" args)))
  58
  59 (define* (build #:key parallel-build?
  60                 #:allow-other-keys)
  61   "Build a given meson package."
  62   (invoke "ninja" "-j" (if parallel-build?
  63                            (number->string (parallel-job-count))
  64                            "1")))
  65
  66 (define* (check #:key test-target parallel-tests? tests?
  67                 #:allow-other-keys)
  68   (setenv "MESON_TESTTHREADS"
  69           (if parallel-tests?
  70               (number->string (parallel-job-count))
  71               "1"))
  72   (if tests?
  73       (invoke "ninja" test-target)
  74       (format #t "test suite not run~%"))
  75   #t)
  76
  77 (define* (install #:rest args)
  78   (invoke "ninja" "install"))
  79
  80 (define* (shrink-runpath #:key (elf-directories '("lib" "lib64" "libexec"
  81                                                   "bin" "sbin"))
  82                          outputs #:allow-other-keys)
  83   "Go through all ELF files from ELF-DIRECTORIES and shrink the RUNPATH
  84 since a lot of directories are left over from the build phase of meson,
  85 for example libraries only needed for the tests."
  86
  87   (define handle-output
  88     (match-lambda
  89       ((output . directory)
  90        (let* ((elf-dirnames (map (lambda (subdir)
  91                                    (string-append directory "/" subdir))
  92                                  elf-directories))
  93               (existing-elf-dirs (filter (lambda (dir)
  94                                             (and (file-exists? dir)
  95                                                  (file-is-directory? dir)))
  96                                           elf-dirnames))
  97               (elf-pred (lambda (name stat)
  98                           (elf-file? name)))
  99               (elf-list (concatenate (map (lambda (dir)
 100                                             (find-files dir elf-pred))
 101                                           existing-elf-dirs))))
 102          (for-each strip-runpath elf-list)))))
 103   (for-each handle-output outputs)
 104   #t)
 105
 106 (define %standard-phases
 107   ;; The standard-phases of glib-or-gtk contains a superset of the phases
 108   ;; from the gnu-build-system.  If the glib-or-gtk? key is #f (the default)
 109   ;; then the extra phases will be removed again in (guix build-system meson).
 110   (modify-phases glib-or-gtk:%standard-phases
 111     (delete 'bootstrap)
 112     (replace 'configure configure)
 113     (replace 'build build)
 114     (replace 'check check)
 115     (replace 'install install)
 116     (add-after 'strip 'shrink-runpath shrink-runpath)))
 117
 118 (define* (meson-build #:key inputs phases
 119                       #:allow-other-keys #:rest args)
 120   "Build the given package, applying all of PHASES in order."
 121   (apply gnu:gnu-build #:inputs inputs #:phases phases args))
 122
 123 ;;; meson-build-system.scm ends here