Subject: Re: [bug#28444] [PATCH 3/3] build-system: Add 'meson-build-system'.

From: Peter Mikkelsen <[email-masked]>
Date: Sat, 16 Sep 2017 13:08:37 +0200

2017-09-15 23:07 GMT+02:00 Ludovic Courtès <[email-masked]>:
>
> Peter Mikkelsen <[email-masked]> skribis:
>
> > * 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'.
>
> Overall LGTM!  I have minor questions and comments:
>
> > +(define* (configure #:key outputs configure-flags build-type
> > +                    #:allow-other-keys)
> > +  "Configure the given package"
>
> Make sure to add a period at the end of sentences.  :-)

Oops, will do :)

>
> > +(define* (fix-runpath #:key elf-directories outputs
> > +                      #:allow-other-keys)
>
> ELF-DIRECTORIES should default to a list, probably the empty list (here
> it defaults to #f, which cannot work.)

I thought it was enough giving it a default value in
guix/build-system/meson.scm, but allright, I have added it here.

>
> > +  "Try to make sure all ELF files in ELF-DIRECTORIES are able to find their
> > +local dependencies in their RUNPATH.  Also shrink the RUNPATH to what is needed,
> > +since alot of directories are left over from meson."
>
> “a lot”
>
> According to this description, half of it corresponds to the
> ‘validate-runpath’ phase, no?

To my understanding 'validate-runpath' just checks and complains, but
this phase checks if it can find any dependencies in directories that
are local to the package, and if it can, it adds them to the runpath.
I have tried to update the description :)
>
> The second half is the shrink-RUNPATH thing, but can you clarify why it
> is needed?  Which directories in RUNPATH are “left over from meson”?

I also tried giving an example of that in the new description.
>
> > +  (define (find-deps dep-name elf-files)
> > +    "Find the directories (if any) that contains DEP-NAME.  The directories
> > +searched are the ones that ELF-FILES are in."
> > +    (let* ((matches (filter (lambda (file)
> > +                              (string=? dep-name (basename file)))
> > +                            elf-files)))
> > +      (map dirname matches)))
>
> Avoid local variable ‘matches’, to keep it concise.  Also, for inner
> ‘define’s, use a comment instead of a docstring (the docstring would be
> inaccessible.)
>
OK.

> > +  (define (file-needed file)
> > +    "Return a list of libraries that FILE needs."
> > +    (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)
> > +          '())))
> > +
> > +  (define (handle-file file elf-files)
> > +    "If FILE needs any libs that are part of ELF-FILES, the RUNPATH
> > +is modified accordingly."
> > +    (let* ((dep-dirs (apply append (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
> > +              (elf-list (apply append (map (lambda (dir)
> > +                                             (find-files dir elf-pred))
> > +                                           excisting-elf-dirs))))
>
> (apply append lstlst) = (concatenate lstlst)
>
I assume it is the 'concatenate' from (srfi srfi-1), so I have added
it to the imports
> That’s it!  Could you comment and send an updated patch?
>
> Thanks for working on it, looks like it’s going to be useful very soon!
>
> Ludo’.

Updated patch attached, thanks for reviewing!

Peter
From 8185c2a154c7473d3b50351246cc83b792ec6a57 Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <[email-masked]>
Date: Wed, 13 Sep 2017 14:37:39 +0200
Subject: [PATCH] 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'.
---
 Makefile.am                       |   2 +
 doc/guix.texi                     |  55 ++++++++++++
 guix/build-system/meson.scm       | 178 ++++++++++++++++++++++++++++++++++++++
 guix/build/meson-build-system.scm | 149 +++++++++++++++++++++++++++++++
 4 files changed, 384 insertions(+)
 create mode 100644 guix/build-system/meson.scm
 create mode 100644 guix/build/meson-build-system.scm

diff --git a/Makefile.am b/Makefile.am
index 4c2e77d19..adeb6e621 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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		\
diff --git a/doc/guix.texi b/doc/guix.texi
index 063369122..16bb20b4a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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 @code{meson} and @code{ninja} to the set of inputs, and they
+can be changed with the parameters @code{#:meson} and @code{#:ninja} if needed.
+The default @code{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.
+
+The 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 @var{``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 @var{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 @var{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,
diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm
new file mode 100644
index 000000000..d66ec760a
--- /dev/null
+++ b/guix/build-system/meson.scm
@@ -0,0 +1,178 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Peter Mikkelsen <[email-masked]>
+;;;
+;;; 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
diff --git a/guix/build/meson-build-system.scm b/guix/build/meson-build-system.scm
new file mode 100644
index 000000000..51542974e
--- /dev/null
+++ b/guix/build/meson-build-system.scm
@@ -0,0 +1,149 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Peter Mikkelsen <[email-masked]>
+;;;
+;;; 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
+            %glib-or-gtk-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)
+  (unless parallel-tests?
+    (setenv "MESON_TESTTHREADS" "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))
+              (excisting-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))
+                                          excisting-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
-- 
2.14.1