From 436515cdb8a2b0c8d8310c6f780b1a35bfb5e7da Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Thu, 26 Apr 2018 02:15:56 +0200 Subject: build: Add the Android NDK build-system. * guix/build-system/android-ndk.scm: New file. * guix/build/android-ndk-build-system.scm: New file. * Makefile.am: Add them. --- guix/build/android-ndk-build-system.scm | 86 +++++++++++++++++++++++++++++++++ 1 file changed, 86 insertions(+) create mode 100644 guix/build/android-ndk-build-system.scm (limited to 'guix/build') diff --git a/guix/build/android-ndk-build-system.scm b/guix/build/android-ndk-build-system.scm new file mode 100644 index 0000000000..b5d4b36d30 --- /dev/null +++ b/guix/build/android-ndk-build-system.scm @@ -0,0 +1,86 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Danny Milosavljevic +;;; +;;; 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 . + +(define-module (guix build android-ndk-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build syscalls) + #:use-module (guix build utils) + #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 ftw) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (%standard-phases + android-ndk-build)) + +;; Commentary: +;; +;; Builder-side code of the Android NDK build system. +;; +;; Code: + +(define* (configure #:key inputs outputs #:allow-other-keys) + (let ((library-directories (filter-map (match-lambda + ((name . path) + (if (eq? 'directory (stat:type (stat path))) + path + #f))) + inputs))) + (setenv "CC" "gcc") + (setenv "CXX" "g++") + (setenv "CPPFLAGS" + (string-join + (map (cut string-append "-I " <> "/include") library-directories) + " ")) + (setenv "LDFLAGS" + (string-append "-L . " + (string-join + (map (lambda (x) + (string-append "-L " x "/lib" " -Wl,-rpath=" x "/lib")) + library-directories) + " "))) + #t)) + +(define* (install #:key inputs outputs (make-flags '()) #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (apply invoke "make" "install" + (string-append "prefix=" out) + make-flags) + (if (file-exists? "include") + (copy-recursively "include" (string-append out "/include"))) + #t)) + +(define* (check #:key inputs outputs tests? (make-flags '()) #:allow-other-keys) + ;; TODO: Also handle root-level tests. + (when (and (file-exists? "tests") tests?) + (with-directory-excursion "tests" + (apply invoke "make" "check" make-flags)))) + +(define %standard-phases + (modify-phases gnu:%standard-phases + (replace 'configure configure) + (replace 'install install) + (replace 'check check))) + +(define* (android-ndk-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given Android NDK package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) -- cgit v1.2.3 From 9ed36cd3d6a4146f5f314b79a6fd6ada93d03164 Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Thu, 10 May 2018 00:05:58 +0200 Subject: build-system: android-ndk: Support unit tests. * guix/build-system/android-ndk.scm (android-ndk-build): Add googletest. * guix/build/android-ndk-build-system.scm (check): Check whether tests are enabled. Run root-level tests as well. --- guix/build-system/android-ndk.scm | 1 + guix/build/android-ndk-build-system.scm | 14 +++++++++----- 2 files changed, 10 insertions(+), 5 deletions(-) (limited to 'guix/build') diff --git a/guix/build-system/android-ndk.scm b/guix/build-system/android-ndk.scm index 842d983a62..891fc6e042 100644 --- a/guix/build-system/android-ndk.scm +++ b/guix/build-system/android-ndk.scm @@ -113,6 +113,7 @@ (define private-keywords ;; Keep the standard inputs of 'gnu-build-system' ,@(standard-packages))) (build-inputs `(("android-make-stub" ,(module-ref (resolve-interface '(gnu packages android)) 'android-make-stub)) + ("googletest" ,(module-ref (resolve-interface '(gnu packages check)) 'googletest)) ,@native-inputs)) (outputs outputs) (build android-ndk-build) diff --git a/guix/build/android-ndk-build-system.scm b/guix/build/android-ndk-build-system.scm index b5d4b36d30..86d0858488 100644 --- a/guix/build/android-ndk-build-system.scm +++ b/guix/build/android-ndk-build-system.scm @@ -68,11 +68,15 @@ (define* (install #:key inputs outputs (make-flags '()) #:allow-other-keys) (copy-recursively "include" (string-append out "/include"))) #t)) -(define* (check #:key inputs outputs tests? (make-flags '()) #:allow-other-keys) - ;; TODO: Also handle root-level tests. - (when (and (file-exists? "tests") tests?) - (with-directory-excursion "tests" - (apply invoke "make" "check" make-flags)))) +(define* (check #:key target inputs outputs (tests? (not target)) (make-flags '()) #:allow-other-keys) + (if tests? + (begin + (apply invoke "make" "check" make-flags) + (when (and (file-exists? "tests") tests?) + (with-directory-excursion "tests" + (apply invoke "make" "check" make-flags)))) + (format #t "test suite not run~%")) + #t) (define %standard-phases (modify-phases gnu:%standard-phases -- cgit v1.2.3 From 3766aa921bdb4732b30e7787f2e3abc37624f291 Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Thu, 10 May 2018 01:03:54 +0200 Subject: build-system: android-ndk: Let upstream install header files. * guix/build/android-ndk-build-system.scm (install): Don't install header files ourselves. --- guix/build/android-ndk-build-system.scm | 2 -- 1 file changed, 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/android-ndk-build-system.scm b/guix/build/android-ndk-build-system.scm index 86d0858488..3c8f726d1d 100644 --- a/guix/build/android-ndk-build-system.scm +++ b/guix/build/android-ndk-build-system.scm @@ -64,8 +64,6 @@ (define* (install #:key inputs outputs (make-flags '()) #:allow-other-keys) (apply invoke "make" "install" (string-append "prefix=" out) make-flags) - (if (file-exists? "include") - (copy-recursively "include" (string-append out "/include"))) #t)) (define* (check #:key target inputs outputs (tests? (not target)) (make-flags '()) #:allow-other-keys) -- cgit v1.2.3 From dac1c97d131d297134fa878ac240d9ec0127044b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 28 Apr 2018 17:17:33 +0200 Subject: union: Add 'relative-file-name'. * guix/build/union.scm (%not-slash): New variable. (relative-file-name): New procedure. * tests/union.scm (test-relative-file-name): New macro and tests. --- guix/build/union.scm | 41 ++++++++++++++++++++++++++++++++++++++++- tests/union.scm | 18 ++++++++++++++++++ tests/utils.scm | 2 +- 3 files changed, 59 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/union.scm b/guix/build/union.scm index 1179f1234b..82d6199d9e 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -27,7 +27,9 @@ (define-module (guix build union) #:use-module (rnrs io ports) #:export (union-build - warn-about-collision)) + warn-about-collision + + relative-file-name)) ;;; Commentary: ;;; @@ -174,4 +176,41 @@ (define (add-to-table! file dir) (union-of-directories output (delete-duplicates inputs))) + +;;; +;;; Relative symlinks. +;;; + +(define %not-slash + (char-set-complement (char-set #\/))) + +(define (relative-file-name reference file) + "Given REFERENCE and FILE, both of which are absolute file names, return the +file name of FILE relative to REFERENCE. + + (relative-file-name \"/gnu/store/foo\" \"/gnu/store/bin/bar\") + => \"../bin/bar\" + +Note that this is from a purely lexical standpoint; conversely, \"..\" is +*not* resolved lexically on POSIX in the presence of symlinks." + (if (and (string-prefix? "/" file) (string-prefix? "/" reference)) + (let loop ((reference (string-tokenize reference %not-slash)) + (file (string-tokenize file %not-slash))) + (define (finish) + (string-join (append (make-list (length reference) "..") file) + "/")) + + (match reference + (() + (finish)) + ((head . tail) + (match file + (() + (finish)) + ((head* . tail*) + (if (string=? head head*) + (loop tail tail*) + (finish))))))) + file)) + ;;; union.scm ends here diff --git a/tests/union.scm b/tests/union.scm index aa95cae001..5a6a4033fc 100644 --- a/tests/union.scm +++ b/tests/union.scm @@ -184,4 +184,22 @@ (define %store (file-is-directory? "bin") (eq? 'symlink (stat:type (lstat "bin/guile")))))))) +(letrec-syntax ((test-relative-file-name + (syntax-rules (=>) + ((_ (reference file => expected) rest ...) + (begin + (test-equal (string-append "relative-file-name " + reference " " file) + expected + (relative-file-name reference file)) + (test-relative-file-name rest ...))) + ((_) + #t)))) + (test-relative-file-name + ("/a/b" "/a/c/d" => "../c/d") + ("/a/b" "/a/b" => "") + ("/a/b" "/a" => "..") + ("/a/b" "/a/b/c/d" => "c/d") + ("/a/b/c" "/a/d/e/f" => "../../d/e/f"))) + (test-end) diff --git a/tests/utils.scm b/tests/utils.scm index 035886dd16..197182acf7 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2016 Mathieu Lirzin ;;; -- cgit v1.2.3 From e00ade3fb81f89cd7c030f998ccd3e07ef2628f0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 28 Apr 2018 22:20:36 +0200 Subject: profiles: Optionally use relative file names for symlink targets. * guix/build/union.scm (symlink-relative): New procedure. * guix/build/profiles.scm: Re-export it. (build-profile): Add #:symlink and pass it to 'union-build'. * guix/profiles.scm (profile-derivation): Add #:relative-symlinks?. Pass #:symlink to 'build-profile'. * tests/profiles.scm ("profile-derivation relative symlinks, one entry") ("profile-derivation relative symlinks, two entries"): New tests. --- guix/build/profiles.scm | 14 +++++++++----- guix/build/union.scm | 9 ++++++++- guix/profiles.scm | 7 +++++++ tests/profiles.scm | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 70 insertions(+), 6 deletions(-) (limited to 'guix/build') diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm index b4160fba1b..819688a913 100644 --- a/guix/build/profiles.scm +++ b/guix/build/profiles.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2017 Ludovic Courtès +;;; Copyright © 2015, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +24,7 @@ (define-module (guix build profiles) #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 pretty-print) + #:re-export (symlink-relative) ;for convenience #:export (ensure-writable-directory build-profile)) @@ -129,12 +130,15 @@ (define (unsymlink link) (apply throw args)))))) (define* (build-profile output inputs - #:key manifest search-paths) - "Build a user profile from INPUTS in directory OUTPUT. Write MANIFEST, an -sexp, to OUTPUT/manifest. Create OUTPUT/etc/profile with Bash definitions for --all the variables listed in SEARCH-PATHS." + #:key manifest search-paths + (symlink symlink)) + "Build a user profile from INPUTS in directory OUTPUT, using SYMLINK to +create symlinks. Write MANIFEST, an sexp, to OUTPUT/manifest. Create +OUTPUT/etc/profile with Bash definitions for -all the variables listed in +SEARCH-PATHS." ;; Make the symlinks. (union-build output inputs + #:symlink symlink #:log-port (%make-void-port "w")) ;; Store meta-data. diff --git a/guix/build/union.scm b/guix/build/union.scm index 82d6199d9e..24b366af45 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -29,7 +29,8 @@ (define-module (guix build union) warn-about-collision - relative-file-name)) + relative-file-name + symlink-relative)) ;;; Commentary: ;;; @@ -213,4 +214,10 @@ (define (finish) (finish))))))) file)) +(define (symlink-relative old new) + "Assuming both OLD and NEW are absolute file names, make NEW a symlink to +OLD, but using a relative file name." + (symlink (relative-file-name (dirname new) old) + new)) + ;;; union.scm ends here diff --git a/guix/profiles.scm b/guix/profiles.scm index 95dc9746bd..c17961c987 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1202,6 +1202,7 @@ (define* (profile-derivation manifest (hooks %default-profile-hooks) (locales? #t) (allow-collisions? #f) + (relative-symlinks? #f) system target) "Return a derivation that builds a profile (aka. 'user environment') with the given MANIFEST. The profile includes additional derivations returned by @@ -1213,6 +1214,9 @@ (define* (profile-derivation manifest When LOCALES? is true, the build is performed under a UTF-8 locale; this adds a dependency on the 'glibc-utf8-locales' package. +When RELATIVE-SYMLINKS? is true, use relative file names for symlink targets. +This is one of the things to do for the result to be relocatable. + When TARGET is true, it must be a GNU triplet, and the packages in MANIFEST are cross-built for TARGET." (mlet* %store-monad ((system (if system @@ -1275,6 +1279,9 @@ (define search-paths (manifest-entries manifest)))))) (build-profile #$output '#$inputs + #:symlink #$(if relative-symlinks? + #~symlink-relative + #~symlink) #:manifest '#$(manifest->gexp manifest) #:search-paths search-paths)))) diff --git a/tests/profiles.scm b/tests/profiles.scm index 8d3cfe91d3..c668c2b831 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -223,6 +223,52 @@ (define glibc (string=? (dirname (readlink bindir)) (derivation->output-path guile)))))) +(test-assertm "profile-derivation relative symlinks, one entry" + (mlet* %store-monad + ((entry -> (package->manifest-entry %bootstrap-guile)) + (guile (package->derivation %bootstrap-guile)) + (drv (profile-derivation (manifest (list entry)) + #:relative-symlinks? #t + #:hooks '() + #:locales? #f)) + (profile -> (derivation->output-path drv)) + (bindir -> (string-append profile "/bin")) + (_ (built-derivations (list drv)))) + (return (and (file-exists? (string-append bindir "/guile")) + (string=? (readlink bindir) + (string-append "../" + (basename + (derivation->output-path guile)) + "/bin")))))) + +(unless (network-reachable?) (test-skip 1)) +(test-assertm "profile-derivation relative symlinks, two entries" + (mlet* %store-monad + ((gnu-make-boot0 -> (@@ (gnu packages commencement) gnu-make-boot0)) + (manifest -> (packages->manifest + (list %bootstrap-guile gnu-make-boot0))) + (guile (package->derivation %bootstrap-guile)) + (make (package->derivation gnu-make-boot0)) + (drv (profile-derivation manifest + #:relative-symlinks? #t + #:hooks '() + #:locales? #f)) + (profile -> (derivation->output-path drv)) + (bindir -> (string-append profile "/bin")) + (_ (built-derivations (list drv)))) + (return (and (file-exists? (string-append bindir "/guile")) + (file-exists? (string-append bindir "/make")) + (string=? (readlink (string-append bindir "/guile")) + (string-append "../../" + (basename + (derivation->output-path guile)) + "/bin/guile")) + (string=? (readlink (string-append bindir "/make")) + (string-append "../../" + (basename + (derivation->output-path make)) + "/bin/make")))))) + (test-assertm "profile-derivation, inputs" (mlet* %store-monad ((entry -> (package->manifest-entry packages:glibc "debug")) -- cgit v1.2.3