From 57f068bec5349e250ce321262609ca8978a81f7f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 19 Jan 2017 23:20:57 +0100 Subject: syscalls: Extract 'bytes->string'. * guix/build/syscalls.scm (bytes->string): New procedure. (bytevector->string-list): Use it. --- guix/build/syscalls.scm | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 2e37846ff0..c06013cd08 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -900,6 +900,15 @@ bytevector BV at INDEX." ;; The most terrible interface, live from Scheme. (syscall->procedure int "ioctl" (list int unsigned-long '*))) +(define (bytes->string bytes) + "Read BYTES, a list of bytes, and return the null-terminated string decoded +from there, or #f if that would be an empty string." + (match (take-while (negate zero?) bytes) + (() + #f) + (non-zero + (list->string (map integer->char non-zero))))) + (define (bytevector->string-list bv stride len) "Return the null-terminated strings found in BV every STRIDE bytes. Read at most LEN bytes from BV." @@ -911,9 +920,7 @@ most LEN bytes from BV." (reverse result)) (_ (loop (drop bytes stride) - (cons (list->string (map integer->char - (take-while (negate zero?) bytes))) - result)))))) + (cons (bytes->string bytes) result)))))) (define* (network-interface-names #:optional sock) "Return the names of existing network interfaces. This is typically limited -- cgit v1.2.3 From 150309726f221c9b982e594466d35f5b895391d5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 19 Jan 2017 23:21:25 +0100 Subject: syscalls: Add utmpx procedures and data structure. * guix/build/syscalls.scm (): New record type. (%utmpx): New C struct. (login-type): New bits. (setutxent, endutxent, getutxent, utmpx-entries): New procedures. --- guix/build/syscalls.scm | 113 +++++++++++++++++++++++++++++++++++++++++++++++- tests/syscalls.scm | 13 +++++- 2 files changed, 124 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index c06013cd08..475fc96490 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -25,6 +25,7 @@ #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-19) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 match) @@ -126,7 +127,22 @@ window-size-x-pixels window-size-y-pixels terminal-window-size - terminal-columns)) + terminal-columns + + utmpx? + utmpx-login-type + utmpx-pid + utmpx-line + utmpx-id + utmpx-user + utmpx-host + utmpx-termination-status + utmpx-exit-status + utmpx-session-id + utmpx-time + utmpx-address + login-type + utmpx-entries)) ;;; Commentary: ;;; @@ -1487,4 +1503,99 @@ always a positive integer." (fall-back) (apply throw args)))))) + +;;; +;;; utmpx. +;;; + +(define-record-type + (utmpx type pid line id user host termination exit + session time address) + utmpx? + (type utmpx-login-type) ;login-type + (pid utmpx-pid) + (line utmpx-line) ;device name + (id utmpx-id) + (user utmpx-user) ;user name + (host utmpx-host) ;host name | #f + (termination utmpx-termination-status) + (exit utmpx-exit-status) + (session utmpx-session-id) ;session ID, for windowing + (time utmpx-time) ;entry time + (address utmpx-address)) + +(define-c-struct %utmpx ; + sizeof-utmpx + (lambda (type pid line id user host termination exit session + seconds useconds address %reserved) + (utmpx type pid + (bytes->string line) id + (bytes->string user) + (bytes->string host) termination exit + session + (make-time time-utc (* 1000 useconds) seconds) + address)) + read-utmpx + write-utmpx! + (type short) + (pid int) + (line (array uint8 32)) + (id (array uint8 4)) + (user (array uint8 32)) + (host (array uint8 256)) + (termination short) + (exit short) + (session int32) + (time-seconds int32) + (time-useconds int32) + (address-v6 (array int32 4)) + (%reserved (array uint8 20))) + +(define-bits login-type + %unused-login-type->symbols + (define EMPTY 0) ;No valid user accounting information. + (define RUN_LVL 1) ;The system's runlevel. + (define BOOT_TIME 2) ;Time of system boot. + (define NEW_TIME 3) ;Time after system clock changed. + (define OLD_TIME 4) ;Time when system clock changed. + + (define INIT_PROCESS 5) ;Process spawned by the init process. + (define LOGIN_PROCESS 6) ;Session leader of a logged in user. + (define USER_PROCESS 7) ;Normal process. + (define DEAD_PROCESS 8) ;Terminated process. + + (define ACCOUNTING 9)) ;System accounting. + +(define setutxent + (let ((proc (syscall->procedure void "setutxent" '()))) + (lambda () + "Open the user accounting database." + (proc)))) + +(define endutxent + (let ((proc (syscall->procedure void "endutxent" '()))) + (lambda () + "Close the user accounting database." + (proc)))) + +(define getutxent + (let ((proc (syscall->procedure '* "getutxent" '()))) + (lambda () + "Return the next entry from the user accounting database." + (let ((ptr (proc))) + (if (null-pointer? ptr) + #f + (read-utmpx (pointer->bytevector ptr sizeof-utmpx))))))) + +(define (utmpx-entries) + "Return the list of entries read from the user accounting database." + (setutxent) + (let loop ((entries '())) + (match (getutxent) + (#f + (endutxent) + (reverse entries)) + ((? utmpx? entry) + (loop (cons entry entries)))))) + ;;; syscalls.scm ends here diff --git a/tests/syscalls.scm b/tests/syscalls.scm index e4ef32c522..fb2c8e7100 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès ;;; Copyright © 2015 David Thompson ;;; ;;; This file is part of GNU Guix. @@ -441,6 +441,17 @@ (> (terminal-columns (open-input-string "Join us now, share the software!")) 0)) +(test-assert "utmpx-entries" + (match (utmpx-entries) + (((? utmpx? entries) ...) + (every (lambda (entry) + (match (utmpx-user entry) + ((? string?) + (> (utmpx-pid entry) 0)) + (#f ;might be DEAD_PROCESS + #t))) + entries)))) + (test-end) (false-if-exception (delete-file temp-file)) -- cgit v1.2.3 From 3483f004a98f103acff96effe1309cc620372e79 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 24 Jan 2017 00:35:16 +0100 Subject: syscalls: Export 'read-utmpx'. * guix/build/syscalls.scm (read-utmpx-from-port): New procedure. * tests/syscalls.scm ("read-utmpx, EOF") ("read-utmpx"): New tests. --- guix/build/syscalls.scm | 13 ++++++++++++- tests/syscalls.scm | 9 +++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 475fc96490..b68c48a05a 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -21,6 +21,7 @@ (define-module (guix build syscalls) #:use-module (system foreign) #:use-module (rnrs bytevectors) + #:autoload (ice-9 binary-ports) (get-bytevector-n) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) @@ -142,7 +143,8 @@ utmpx-time utmpx-address login-type - utmpx-entries)) + utmpx-entries + (read-utmpx-from-port . read-utmpx))) ;;; Commentary: ;;; @@ -1598,4 +1600,13 @@ always a positive integer." ((? utmpx? entry) (loop (cons entry entries)))))) +(define (read-utmpx-from-port port) + "Read a utmpx entry from PORT. Return either the EOF object or a utmpx +entry." + (match (get-bytevector-n port sizeof-utmpx) + ((? eof-object? eof) + eof) + ((? bytevector? bv) + (read-utmpx bv)))) + ;;; syscalls.scm ends here diff --git a/tests/syscalls.scm b/tests/syscalls.scm index fb2c8e7100..92e02f3303 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -452,6 +452,15 @@ #t))) entries)))) +(test-assert "read-utmpx, EOF" + (eof-object? (read-utmpx (%make-void-port "r")))) + +(unless (access? "/var/run/utmpx" O_RDONLY) + (tes-skip 1)) +(test-assert "read-utmpx" + (let ((result (call-with-input-file "/var/run/utmpx" read-utmpx))) + (or (utmpx? result) (eof-object? result)))) + (test-end) (false-if-exception (delete-file temp-file)) -- cgit v1.2.3 From 0db2ff65e7101951fedf4357aa37aaf92f7df431 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 25 Jan 2017 20:52:27 +0100 Subject: bournish: Extend 'rm' command. * guix/build/bournish.scm (rm-command): New procedure. (%commands): Use it. * tests/bournish.scm: Add tests for "rm" and "rm -r". --- guix/build/bournish.scm | 11 ++++++++++- tests/bournish.scm | 12 ++++++++++++ 2 files changed, 22 insertions(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/bournish.scm b/guix/build/bournish.scm index 51dad17ba7..e948cd03d3 100644 --- a/guix/build/bournish.scm +++ b/guix/build/bournish.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Ludovic Courtès ;;; Copyright © 2016 Efraim Flashner +;;; Copyright © 2017 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -105,6 +106,14 @@ characters." ((@ (guix build utils) dump-port) port (current-output-port)) *unspecified*))) +(define (rm-command . args) + "Emit code for the 'rm' command." + (cond ((member "-r" args) + `(for-each (@ (guix build utils) delete-file-recursively) + (list ,@(delete "-r" args)))) + (else + `(for-each delete-file (list ,@args))))) + (define (lines+chars port) "Return the number of lines and number of chars read from PORT." (let loop ((lines 0) (chars 0)) @@ -194,7 +203,7 @@ commands such as 'ls' and 'cd'; it lacks globbing, pipes---everything.\n")) `(("echo" ,(lambda strings `(list ,@strings))) ("cd" ,(lambda (dir) `(chdir ,dir))) ("pwd" ,(lambda () `(getcwd))) - ("rm" ,(lambda (file) `(delete-file ,file))) + ("rm" ,rm-command) ("cp" ,(lambda (source dest) `(copy-file ,source ,dest))) ("help" ,help-command) ("ls" ,ls-command) diff --git a/tests/bournish.scm b/tests/bournish.scm index 0f529ce42f..3b40ce2643 100644 --- a/tests/bournish.scm +++ b/tests/bournish.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Ludovic Courtès +;;; Copyright © 2017 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -38,5 +39,16 @@ (read-and-compile (open-input-string "cd /foo\npwd\nls") #:from %bournish-language #:to 'scheme)) +(test-equal "rm" + '(for-each delete-file (list "foo" "bar")) + (read-and-compile (open-input-string "rm foo bar\n") + #:from %bournish-language #:to 'scheme)) + +(test-equal "rm -r" + '(for-each (@ (guix build utils) delete-file-recursively) + (list "/foo" "/bar")) + (read-and-compile (open-input-string "rm -r /foo /bar\n") + #:from %bournish-language #:to 'scheme)) + (test-end "bournish") -- cgit v1.2.3 From de643f0c15677665acce73db9c28c5488e623633 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 1 Feb 2017 12:08:45 +0100 Subject: build: r-build-system: Use deterministic built date. Fixes . * guix/build/r-build-system.scm (install): Pass "--built-timestamp" option to make build deterministic. --- guix/build/r-build-system.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/r-build-system.scm b/guix/build/r-build-system.scm index 3fc13eb835..24aa73d4f2 100644 --- a/guix/build/r-build-system.scm +++ b/guix/build/r-build-system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Ricardo Wurmus +;;; Copyright © 2015, 2017 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -84,6 +84,7 @@ (params (append configure-flags (list "--install-tests" (string-append "--library=" site-library) + "--built-timestamp=1970-01-01" "."))) (site-path (string-append site-library ":" (generate-site-path inputs)))) -- cgit v1.2.3 From 65e862d1a2914ad61201236c155058bcf33b5b9c Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Mon, 6 Feb 2017 16:45:08 +0100 Subject: gnu: Add dub-build-system. * guix/build-system/dub.scm: New file. * guix/build/dub-build-system.scm: New file. * Makefile.am (MODULES): Add them. * doc/guix.texi: Add section for dub-build-system. --- Makefile.am | 2 + doc/guix.texi | 10 +++ guix/build-system/dub.scm | 147 ++++++++++++++++++++++++++++++++++++++++ guix/build/dub-build-system.scm | 125 ++++++++++++++++++++++++++++++++++ 4 files changed, 284 insertions(+) create mode 100644 guix/build-system/dub.scm create mode 100644 guix/build/dub-build-system.scm (limited to 'guix/build') diff --git a/Makefile.am b/Makefile.am index 18501bddfc..8fe22d48ad 100644 --- a/Makefile.am +++ b/Makefile.am @@ -64,6 +64,7 @@ MODULES = \ guix/build-system/ant.scm \ guix/build-system/cargo.scm \ guix/build-system/cmake.scm \ + guix/build-system/dub.scm \ guix/build-system/emacs.scm \ guix/build-system/asdf.scm \ guix/build-system/glib-or-gtk.scm \ @@ -88,6 +89,7 @@ MODULES = \ guix/build/download.scm \ guix/build/cargo-build-system.scm \ guix/build/cmake-build-system.scm \ + guix/build/dub-build-system.scm \ guix/build/emacs-build-system.scm \ guix/build/asdf-build-system.scm \ guix/build/git.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index eca2d99487..50cab274af 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3438,6 +3438,16 @@ Which Haskell compiler is used can be specified with the @code{#:haskell} parameter which defaults to @code{ghc}. @end defvr +@defvr {Scheme Variable} dub-build-system +This variable is exported by @code{(guix build-system dub)}. It +implements the Dub build procedure used by D packages, which +involves running @code{dub build} and @code{dub run}. +Installation is done by copying the files manually. + +Which D compiler is used can be specified with the @code{#:ldc} +parameter which defaults to @code{ldc}. +@end defvr + @defvr {Scheme Variable} emacs-build-system This variable is exported by @code{(guix build-system emacs)}. It implements an installation procedure similar to the packaging system diff --git a/guix/build-system/dub.scm b/guix/build-system/dub.scm new file mode 100644 index 0000000000..13c89e8648 --- /dev/null +++ b/guix/build-system/dub.scm @@ -0,0 +1,147 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2013 Andreas Enge +;;; Copyright © 2013 Nikita Karetnikov +;;; Copyright © 2016 David Craven +;;; Copyright © 2016 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-system dub) + #:use-module (guix search-paths) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix derivations) + #:use-module (guix packages) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (ice-9 match) + #:use-module (srfi srfi-26) + #:export (dub-build-system)) + +(define (default-ldc) + "Return the default ldc package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((ldc (resolve-interface '(gnu packages ldc)))) + (module-ref ldc 'ldc))) + +(define (default-dub) + "Return the default dub package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((ldc (resolve-interface '(gnu packages ldc)))) + (module-ref ldc 'dub))) + +(define (default-pkg-config) + "Return the default pkg-config package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((pkg-config (resolve-interface '(gnu packages pkg-config)))) + (module-ref pkg-config 'pkg-config))) + +(define %dub-build-system-modules + ;; Build-side modules imported by default. + `((guix build dub-build-system) + (guix build syscalls) + ,@%gnu-build-system-modules)) + +(define* (dub-build store name inputs + #:key + (tests? #t) + (test-target #f) + (dub-build-flags ''()) + (phases '(@ (guix build dub-build-system) + %standard-phases)) + (outputs '("out")) + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules %dub-build-system-modules) + (modules '((guix build dub-build-system) + (guix build utils)))) + "Build SOURCE using DUB, and with INPUTS." + (define builder + `(begin + (use-modules ,@modules) + (dub-build #:name ,name + #:source ,(match (assoc-ref inputs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) + source) + (source + source)) + #:system ,system + #:test-target ,test-target + #:dub-build-flags ,dub-build-flags + #:tests? ,tests? + #:phases ,phases + #:outputs %outputs + #:search-paths ',(map search-path-specification->sexp + search-paths) + #:inputs %build-inputs))) + + (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 + #:inputs inputs + #:system system + #:modules imported-modules + #:outputs outputs + #:guile-for-build guile-for-build)) + +(define* (lower name + #:key source inputs native-inputs outputs system target + (ldc (default-ldc)) + (dub (default-dub)) + (pkg-config (default-pkg-config)) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME." + + (define private-keywords + '(#:source #:target #:ldc #:dub #:pkg-config #:inputs #:native-inputs #:outputs)) + + (and (not target) ;; TODO: support cross-compilation + (bag + (name name) + (system system) + (target target) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs + + ;; Keep the standard inputs of 'gnu-build-system' + ,@(standard-packages))) + (build-inputs `(("ldc" ,ldc) + ("dub" ,dub) + ,@native-inputs)) + (outputs outputs) + (build dub-build) + (arguments (strip-keyword-arguments private-keywords arguments))))) + +(define dub-build-system + (build-system + (name 'dub) + (description + "DUB build system, to build D packages") + (lower lower))) diff --git a/guix/build/dub-build-system.scm b/guix/build/dub-build-system.scm new file mode 100644 index 0000000000..7c7cd8803c --- /dev/null +++ b/guix/build/dub-build-system.scm @@ -0,0 +1,125 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 David Craven +;;; Copyright © 2017 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 dub-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 + dub-build)) + +;; Commentary: +;; +;; Builder-side code of the DUB (the build tool for D) build system. +;; +;; Code: + +;; FIXME: Needs to be parsed from url not package name. +(define (package-name->d-package-name name) + "Return the package name of NAME." + (match (string-split name #\-) + (("d" rest ...) + (string-join rest "-")) + (_ #f))) + +(define* (configure #:key inputs #:allow-other-keys) + "Prepare one new directory with all the required dependencies. + It's necessary to do this (instead of just using /gnu/store as the + directory) because we want to hide the libraries in subdirectories + lib/dub/... instead of polluting the user's profile root." + (let* ((dir (mkdtemp! "/tmp/dub.XXXXXX")) + (vendor-dir (string-append dir "/vendor"))) + (setenv "HOME" dir) + (mkdir vendor-dir) + (for-each + (match-lambda + ((name . path) + (let* ((d-package (package-name->d-package-name name)) + (d-basename (basename path))) + (when (and d-package path) + (match (string-split (basename path) #\-) + ((_ ... version) + (symlink (string-append path "/lib/dub/" d-basename) + (string-append vendor-dir "/" d-basename)))))))) + inputs) + (zero? (system* "dub" "add-path" vendor-dir)))) + +(define (grep string file-name) + "Find the first occurence of STRING in the file named FILE-NAME. + Return the position of this occurence, or #f if none was found." + (string-contains (call-with-input-file file-name get-string-all) + string)) + +(define (grep* string file-name) + "Find the first occurence of STRING in the file named FILE-NAME. + Return the position of this occurence, or #f if none was found. + If the file named FILE-NAME doesn't exist, return #f." + (catch 'system-error + (lambda () + (grep string file-name)) + (lambda args + #f))) + +(define* (build #:key (dub-build-flags '()) + #:allow-other-keys) + "Build a given DUB package." + (if (or (grep* "sourceLibrary" "package.json") + (grep* "sourceLibrary" "dub.sdl") ; note: format is different! + (grep* "sourceLibrary" "dub.json")) + #t + (let ((status (zero? (apply system* `("dub" "build" ,@dub-build-flags))))) + (system* "dub" "run") ; might fail for "targetType": "library" + status))) + +(define* (check #:key tests? #:allow-other-keys) + (if tests? + (zero? (system* "dub" "test")) + #t)) + +(define* (install #:key inputs outputs #:allow-other-keys) + "Install a given DUB package." + (let* ((out (assoc-ref outputs "out")) + (outbin (string-append out "/bin")) + (outlib (string-append out "/lib/dub/" (basename out)))) + (mkdir-p outbin) + ;; TODO remove "-test-application" + (copy-recursively "bin" outbin) + (mkdir-p outlib) + (copy-recursively "." (string-append outlib)) + #t)) + +(define %standard-phases + (modify-phases gnu:%standard-phases + (replace 'configure configure) + (replace 'build build) + (replace 'check check) + (replace 'install install))) + +(define* (dub-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given DUB package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) -- cgit v1.2.3