From c90f73f8164a209884471f1c41948d0556e6c39e Mon Sep 17 00:00:00 2001 From: Sarah Morgensen Date: Sun, 19 Sep 2021 22:20:49 -0700 Subject: build-system/go: Initialize build cache from input packages. * guix/build/go-build-system.com (setup-go-environment): Set GOCACHE to a location within the build directory. Union "/var/cache/go/build" input directories to initialize the cache. Generate "trim.txt" within the cache, with the current time. Signed-off-by: Leo Famulari --- guix/build/go-build-system.scm | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) (limited to 'guix/build') diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm index 4768ee8562..7f25e05d0d 100644 --- a/guix/build/go-build-system.scm +++ b/guix/build/go-build-system.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2020 Jack Hill ;;; Copyright © 2020 Jakub Kądziołka ;;; Copyright © 2020, 2021 Efraim Flashner +;;; Copyright © 2021 Sarah Morgensen ;;; ;;; This file is part of GNU Guix. ;;; @@ -138,9 +139,28 @@ (define* (setup-go-environment #:key inputs outputs goos goarch #:allow-other-ke where executables (\"commands\") are installed to. This phase is sometimes used by packages that use (guix build-system gnu) but have a handful of Go dependencies, so it should be self-contained." - ;; The Go cache is required starting in Go 1.12. We don't actually use it but - ;; we need it to be a writable directory. - (setenv "GOCACHE" "/tmp/go-cache") + (define (search-input-directories dir) + (filter directory-exists? + (map (match-lambda + ((name . directory) + (string-append directory "/" dir))) + inputs))) + + ;; Seed the Go build cache with the build caches from input packages. + (let ((cache (string-append (getcwd) "/go-build"))) + (setenv "GOCACHE" cache) + (union-build cache + (search-input-directories "/var/cache/go/build") + ;; Creating all directories isn't that bad, because there are + ;; only ever 256 of them. + #:create-all-directories? #t + #:log-port (%make-void-port "w")) + + ;; Tell Go that the cache was recently trimmed, so it doesn't try to. + (call-with-output-file (string-append cache "/trim.txt") + (lambda (port) + (format port "~a" (current-time))))) + ;; Using the current working directory as GOPATH makes it easier for packagers ;; who need to manipulate the unpacked source code. (setenv "GOPATH" (getcwd)) -- cgit v1.2.3 From bfdeba11f86b18172194b416c6eb59b7cc7ef355 Mon Sep 17 00:00:00 2001 From: Ryan Sundberg Date: Wed, 29 Dec 2021 19:52:16 -0800 Subject: linux-container: Handle CLONE_NEWCGROUP and use it by default. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Adds low-level support for launching Linux containers with cgroup namespaces. * gnu/build/linux-container.scm (%namespaces): Add 'cgroup. (namespaces->bit-mask): Handle it. * guix/build/syscalls.scm (CLONE_NEWCGROUP): New variable. Signed-off-by: Ludovic Courtès --- gnu/build/linux-container.scm | 3 ++- guix/build/syscalls.scm | 2 ++ 2 files changed, 4 insertions(+), 1 deletion(-) (limited to 'guix/build') diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm index 4a8bed5a9a..bdeca2cdb9 100644 --- a/gnu/build/linux-container.scm +++ b/gnu/build/linux-container.scm @@ -52,7 +52,7 @@ (define (setgroups-supported?) (file-exists? "/proc/self/setgroups")) (define %namespaces - '(mnt pid ipc uts user net)) + '(cgroup mnt pid ipc uts user net)) (define (call-with-clean-exit thunk) "Apply THUNK, but exit with a status code of 1 if it fails." @@ -210,6 +210,7 @@ (define (namespaces->bit-mask namespaces) ;; Use the same flags as fork(3) in addition to the namespace flags. (apply logior SIGCHLD (map (match-lambda + ('cgroup CLONE_NEWCGROUP) ('mnt CLONE_NEWNS) ('uts CLONE_NEWUTS) ('ipc CLONE_NEWIPC) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 45f95c509d..a7401fd73f 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -132,6 +132,7 @@ (define-module (guix build syscalls) CLONE_CHILD_CLEARTID CLONE_CHILD_SETTID + CLONE_NEWCGROUP CLONE_NEWNS CLONE_NEWUTS CLONE_NEWIPC @@ -1025,6 +1026,7 @@ (define (add-to-entropy-count port-or-fd n) ;; Linux clone flags, from linux/sched.h (define CLONE_CHILD_CLEARTID #x00200000) (define CLONE_CHILD_SETTID #x01000000) +(define CLONE_NEWCGROUP #x02000000) (define CLONE_NEWNS #x00020000) (define CLONE_NEWUTS #x04000000) (define CLONE_NEWIPC #x08000000) -- cgit v1.2.3 From 4b770d3adf7be7291fc15015761bedfeb01aaf05 Mon Sep 17 00:00:00 2001 From: Reily Siegel Date: Thu, 23 Dec 2021 18:04:28 -0500 Subject: build: clojure-utils: Don't try to compile Clojure. * guix/build/clojure-utils.scm (%aot-include): Add "data-readers" to the default list of files to exclude from ahead-of-time compilation. --- guix/build/clojure-utils.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/clojure-utils.scm b/guix/build/clojure-utils.scm index a9ffad3c8f..8817cab52a 100644 --- a/guix/build/clojure-utils.scm +++ b/guix/build/clojure-utils.scm @@ -135,7 +135,7 @@ (define-with-docs %aot-include (define-with-docs %aot-exclude "A default list of symbols deciding what not to compile. See the doc string of '%aot-include' for more details." - '()) + '(data-readers)) (define-with-docs %tests? "Enable tests by default." -- cgit v1.2.3 From d87a1ba6b8b2f08ba6898033353d7463355bd146 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 14 Jan 2022 15:59:37 +0100 Subject: compile: Disable cross-module inlining and related features. This makes no difference on Guile <= 3.0.7. * guix/build/compile.scm (strip-keyword-arguments): New procedure. (optimizations-for-level): Use it to strip keywords related to cross-module inlining. --- guix/build/compile.scm | 32 ++++++++++++++++++++++++++++---- 1 file changed, 28 insertions(+), 4 deletions(-) (limited to 'guix/build') diff --git a/guix/build/compile.scm b/guix/build/compile.scm index b86ec3b743..82761a2190 100644 --- a/guix/build/compile.scm +++ b/guix/build/compile.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2013-2014, 2016-2020, 2022 Ludovic Courtès ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer ;;; ;;; This file is part of GNU Guix. @@ -37,6 +37,21 @@ (define-module (guix build compile) ;;; ;;; Code: +(define (strip-keyword-arguments keywords args) ;XXX: copied from (guix utils) + "Remove all of the keyword arguments listed in KEYWORDS from ARGS." + (let loop ((args args) + (result '())) + (match args + (() + (reverse result)) + (((? keyword? kw) arg . rest) + (loop rest + (if (memq kw keywords) + result + (cons* arg kw result)))) + ((head . tail) + (loop tail (cons head result)))))) + (define optimizations-for-level (or (and=> (false-if-exception (resolve-interface '(system base optimize))) @@ -60,9 +75,18 @@ (define %lightweight-optimizations (loop rest `(#f ,kw ,@result)))))) (lambda (level) - (if (<= level 1) - %lightweight-optimizations - %default-optimizations))))) + ;; In the upcoming Guile 3.0.8, .go files include code of their + ;; inlinable exports and free variables are resolved at compile time + ;; (both are enabled at -O1) to permit cross-module inlining + ;; (enabled at -O2). Unfortunately, this currently leads to + ;; non-reproducible and more expensive builds, so we turn it off + ;; here: + ;; . + (strip-keyword-arguments '(#:inlinable-exports? #:resolve-free-vars? + #:cross-module-inlining?) + (if (<= level 1) + %lightweight-optimizations + %default-optimizations)))))) (define (supported-warning-type? type) "Return true if TYPE, a symbol, denotes a supported warning type." -- cgit v1.2.3 From 5add4af6fcbb030b0146334d21810d4de18238fb Mon Sep 17 00:00:00 2001 From: Philip McGrath Date: Sat, 8 Jan 2022 03:41:49 -0500 Subject: guix: node-build-system: Add delete-lockfiles phase. Guix does not use any of these lock files to determine the package versions used during the build, so they only serve to cause problems. * guix/build/node-build-system.scm (delete-lockfiles): New variable. (%standard-phases): Add 'delete-lockfiles' after 'patch-dependencies'. Signed-off-by: Liliana Marie Prikler --- guix/build/node-build-system.scm | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'guix/build') diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm index 70a367618e..2d7a3bdc67 100644 --- a/guix/build/node-build-system.scm +++ b/guix/build/node-build-system.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 David Thompson ;;; Copyright © 2016, 2020 Jelle Licht ;;; Copyright © 2019, 2021 Timothy Sample +;;; Copyright © 2021 Philip McGrath ;;; ;;; This file is part of GNU Guix. ;;; @@ -96,6 +97,17 @@ (define (resolve-dependencies package-meta meta-key) (write-json package-meta out)))) #t) +(define* (delete-lockfiles #:key inputs #:allow-other-keys) + "Delete 'package-lock.json', 'yarn.lock', and 'npm-shrinkwrap.json', if they +exist." + (for-each (lambda (pth) + (when (file-exists? pth) + (delete-file pth))) + '("package-lock.json" + "yarn.lock" + "npm-shrinkwrap.json")) + #t) + (define* (configure #:key outputs inputs #:allow-other-keys) (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm"))) (invoke npm "--offline" "--ignore-scripts" "install") @@ -146,6 +158,7 @@ (define %standard-phases (modify-phases gnu:%standard-phases (add-after 'unpack 'set-home set-home) (add-before 'configure 'patch-dependencies patch-dependencies) + (add-after 'patch-dependencies 'delete-lockfiles delete-lockfiles) (replace 'configure configure) (replace 'build build) (replace 'check check) -- cgit v1.2.3 From 2ef3fe9f35cf4c4709352600a1370b852b70b27c Mon Sep 17 00:00:00 2001 From: Philip McGrath Date: Sat, 8 Jan 2022 03:41:51 -0500 Subject: guix: node-build-system: Add JSON utilities. This commit adds several utility functions for non-destructive transformation of the JSON representation used by (guix build json), particularly for purely functional update of JSON objects. They ought to eventually be exported from their own module, but for now are kept private to allow experimentation. * guix/build/node-build-system.scm (assoc-ref*, jsobject-ref, alist-pop) (alist-update, jsobject-update*, jsobject-union): New variables. (with-atomic-json-file-replacement): New public variable. (module-name, build, patch-dependencies): Use them. Do not resort to unsafe alist primitives from Guile core. Co-authored-by: Liliana Marie Prikler --- guix/build/node-build-system.scm | 148 +++++++++++++++++++++++++++++++-------- 1 file changed, 118 insertions(+), 30 deletions(-) (limited to 'guix/build') diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm index 2d7a3bdc67..5286a902c7 100644 --- a/guix/build/node-build-system.scm +++ b/guix/build/node-build-system.scm @@ -2,7 +2,8 @@ ;;; Copyright © 2015 David Thompson ;;; Copyright © 2016, 2020 Jelle Licht ;;; Copyright © 2019, 2021 Timothy Sample -;;; Copyright © 2021 Philip McGrath +;;; Copyright © 2021, 2022 Philip McGrath +;;; Copyright © 2022 Liliana Marie Prikler ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,14 +27,104 @@ (define-module (guix build node-build-system) #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-71) #:export (%standard-phases + with-atomic-json-file-replacement node-build)) -;; Commentary: -;; -;; Builder-side code of the standard Node/NPM package install procedure. -;; -;; Code: +(define (with-atomic-json-file-replacement file proc) + "Like 'with-atomic-file-replacement', but PROC is called with a single +argument---the result of parsing FILE's contents as json---and should a value +to be written as json to the replacement FILE." + (with-atomic-file-replacement file + (lambda (in out) + (write-json (proc (read-json in)) out)))) + +(define* (assoc-ref* alist key #:optional default) + "Like assoc-ref, but return DEFAULT instead of #f if no value exists." + (match (assoc key alist) + (#f default) + ((_ . value) value))) + +(define* (jsobject-ref obj key #:optional default) + (match obj + (('@ . alist) (assoc-ref* alist key default)))) + +(define* (alist-pop alist key #:optional (= equal?)) + "Return two values, the first pair in ALIST with key KEY, and the other +elements. Equality calls are made as (= KEY ALISTCAR)." + (define (found? pair) + (= key (car pair))) + + (let ((before after (break found? alist))) + (if (pair? after) + (values (car after) (append before (cdr after))) + (values #f before)))) + +(define* (alist-update alist key proc #:optional default (= equal?)) + "Return an association list like ALIST, but with KEY mapped to the result of +PROC applied to the first value found under the comparison (= KEY ALISTCAR). +If no such value exists, use DEFAULT instead. +Unlike acons, this removes the previous association of KEY (assuming it is +unique), but the result may still share storage with ALIST." + (let ((pair rest (alist-pop alist key =))) + (acons key + (proc (if (pair? pair) + (cdr pair) + default)) + rest))) + +(define (jsobject-update* js . updates) + "Return a json object like JS, but with all UPDATES applied. Each update is +a list (KEY PROC [DEFAULT]), so that KEY is mapped to the result of PROC +applied to the value to which KEY is mapped in JS. If no such mapping exists, +PROC is instead applied to DEFAULT, or to '#f' is no DEFAULT is specified. +The update takes place from left to right, so later UPDATERs will receive the +values returned by earlier UPDATERs for the same KEY." + (match js + (('@ . alist) + (let loop ((alist alist) + (updates updates)) + (match updates + (() (cons '@ alist)) + (((key proc) . updates) + (loop (alist-update alist key proc #f equal?) updates)) + (((key proc default) . updates) + (loop (alist-update alist key proc default equal?) updates))))))) + +(define (jsobject-union combine seed . objects) + "Merge OBJECTS into SEED by applying (COMBINE KEY VAL0 VAL), where VAL0 +is the value found in the (possibly updated) SEED and VAL is the new value +found in one of the OBJECTS." + (match seed + (('@ . aseed) + (match objects + (() seed) + ((('@ . alists) ...) + (cons + '@ + (fold (lambda (alist aseed) + (if (null? aseed) alist + (fold + (match-lambda* + (((k . v) aseed) + (let ((pair tail (alist-pop alist k))) + (match pair + (#f (acons k v aseed)) + ((_ . v0) (acons k (combine k v0 v) aseed)))))) + aseed + alist))) + aseed + alists))))))) + +;; Possibly useful helper functions: +;; (define (newest key val0 val) val) +;; (define (unkeyed->keyed proc) (lambda (_key val0 val) (proc val0 val))) + + +;;; +;;; Phases. +;;; (define (set-home . _) (with-directory-excursion ".." @@ -50,7 +141,7 @@ (define (set-home . _) (define (module-name module) (let* ((package.json (string-append module "/package.json")) (package-meta (call-with-input-file package.json read-json))) - (assoc-ref package-meta "name"))) + (jsobject-ref package-meta "name"))) (define (index-modules input-paths) (define (list-modules directory) @@ -74,27 +165,26 @@ (define* (patch-dependencies #:key inputs #:allow-other-keys) (define index (index-modules (map cdr inputs))) - (define (resolve-dependencies package-meta meta-key) - (fold (lambda (key+value acc) - (match key+value - ('@ acc) - ((key . value) (acons key (hash-ref index key value) acc)))) - '() - (or (assoc-ref package-meta meta-key) '()))) + (define resolve-dependencies + (match-lambda + (('@ . alist) + (cons '@ (map (match-lambda + ((key . value) + (cons key (hash-ref index key value)))) + alist))))) - (with-atomic-file-replacement "package.json" - (lambda (in out) - (let ((package-meta (read-json in))) - (assoc-set! package-meta "dependencies" - (append - '(@) - (resolve-dependencies package-meta "dependencies") - (resolve-dependencies package-meta "peerDependencies"))) - (assoc-set! package-meta "devDependencies" - (append - '(@) - (resolve-dependencies package-meta "devDependencies"))) - (write-json package-meta out)))) + (with-atomic-json-file-replacement "package.json" + (lambda (pkg-meta) + (jsobject-update* + pkg-meta + `("devDependencies" ,resolve-dependencies (@)) + `("dependencies" ,(lambda (deps) + (resolve-dependencies + (jsobject-union + (lambda (k a b) b) + (jsobject-ref pkg-meta "peerDependencies" '(@)) + deps))) + (@))))) #t) (define* (delete-lockfiles #:key inputs #:allow-other-keys) @@ -115,9 +205,7 @@ (define* (configure #:key outputs inputs #:allow-other-keys) (define* (build #:key inputs #:allow-other-keys) (let ((package-meta (call-with-input-file "package.json" read-json))) - (if (and=> (assoc-ref package-meta "scripts") - (lambda (scripts) - (assoc-ref scripts "build"))) + (if (jsobject-ref (jsobject-ref package-meta "scripts" '(@)) "build" #f) (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm"))) (invoke npm "run" "build")) (format #t "there is no build script to run~%")) -- cgit v1.2.3 From df7d787ba45c4d7b5a4a49c7fdb163069ff2e47b Mon Sep 17 00:00:00 2001 From: Philip McGrath Date: Sat, 8 Jan 2022 03:41:52 -0500 Subject: guix: node-build-system: Add avoid-node-gyp-rebuild phase. Packages with native addons currently try to write to store paths when used as dependecies. This patch adds a phase to replace that behaviour with a no-op. * guix/build/node-build-system.scm (avoid-node-gyp-rebuild): New variable. (%standard-phases): Add 'avoid-node-gyp-rebuild' after 'install'. Signed-off-by: Liliana Marie Prikler --- guix/build/node-build-system.scm | 54 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 53 insertions(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm index 5286a902c7..a1556ce4b8 100644 --- a/guix/build/node-build-system.scm +++ b/guix/build/node-build-system.scm @@ -242,6 +242,57 @@ (define* (install #:key outputs inputs #:allow-other-keys) "install" "../package.tgz") #t)) +(define* (avoid-node-gyp-rebuild #:key outputs #:allow-other-keys) + "Adjust the installed 'package.json' to remove an 'install' script that +would try to run 'node-gyp rebuild'." + ;; We want to take advantage of `npm install`'s automatic support for + ;; building native addons with node-gyp: in particular, it helps us avoid + ;; hard-coding the specifics of how npm's internal copy of node-gyp is + ;; currently packaged. However, the mechanism by which the automatic support + ;; is implemented causes problems for us. + ;; + ;; If a package contains a 'binding.gyp' file and does not define an + ;; 'install' or 'preinstall' script, 'npm install' runs a default install + ;; script consisting of 'node-gyp rebuild'. In our 'install' phase, this + ;; implicit 'install' script, if it is applicable, is explicitly added to + ;; the "package.json" file. However, if another Guix package were to use a + ;; Node.js package with such an 'install' script, the dependent package's + ;; build process would fail, because 'node-gyp rebuild' would try to write + ;; to the store. + ;; + ;; Here, if the installed "package.json" defines scripts.install as + ;; "node-gyp rebuild", we replace it with a no-op. Importantly, deleting the + ;; install script definition would not be enough, because the default + ;; install script would cause the same problem. + ;; + ;; For further details, see: + ;; - https://docs.npmjs.com/cli/v8/configuring-npm/package-json#default-values + ;; - https://docs.npmjs.com/cli/v8/using-npm/scripts#best-practices + (define installed-package.json + (search-input-file outputs (string-append "/lib/node_modules/" + (module-name ".") + "/package.json"))) + ;; We don't want to use an atomic replacement here, because we often don't + ;; even need to overwrite this file. Therefore, let's use some helpers + ;; that we'd otherwise not need. + (define pkg-meta + (call-with-input-file installed-package.json read-json)) + (define scripts + (jsobject-ref pkg-meta "scripts" '(@))) + (define (jsobject-set js key val) + (jsobject-update* js (list key (const val)))) + + (when (equal? "node-gyp rebuild" (jsobject-ref scripts "install" #f)) + (call-with-output-file installed-package.json + (lambda (out) + (write-json + (jsobject-set pkg-meta + "scripts" + (jsobject-set scripts + "install" + "echo Guix: avoiding node-gyp rebuild")) + out))))) + (define %standard-phases (modify-phases gnu:%standard-phases (add-after 'unpack 'set-home set-home) @@ -251,7 +302,8 @@ (define %standard-phases (replace 'build build) (replace 'check check) (add-before 'install 'repack repack) - (replace 'install install))) + (replace 'install install) + (add-after 'install 'avoid-node-gyp-rebuild avoid-node-gyp-rebuild))) (define* (node-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) -- cgit v1.2.3 From a62e6e3220e8c7e577b1e682bc1b88273a67de3a Mon Sep 17 00:00:00 2001 From: Philip McGrath Date: Sat, 8 Jan 2022 03:41:53 -0500 Subject: guix: node-build-system: Add 'delete-dependencies' helper function. Many node packages currently skip the configure phase, because they lack both dependencies and a convenient way to build without all of them, e.g. for the purposes of bootstrapping. This patch adds a big hammer to flatten these nails. * guix/build/node-build-system.scm (delete-dependencies): New variable. Signed-off-by: Liliana Marie Prikler --- guix/build/node-build-system.scm | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) (limited to 'guix/build') diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm index a1556ce4b8..bee3792e93 100644 --- a/guix/build/node-build-system.scm +++ b/guix/build/node-build-system.scm @@ -25,11 +25,13 @@ (define-module (guix build node-build-system) #:use-module (guix build utils) #:use-module (guix build json) #:use-module (ice-9 ftw) + #:use-module (ice-9 regex) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-71) #:export (%standard-phases with-atomic-json-file-replacement + delete-dependencies node-build)) (define (with-atomic-json-file-replacement file proc) @@ -187,6 +189,27 @@ (define resolve-dependencies (@))))) #t) +(define (delete-dependencies absent) + "Rewrite 'package.json' to allow the build to proceed without packages +listed in ABSENT, a list of strings naming npm packages. + +To prevent the deleted dependencies from being reintroduced, use this function +only after the 'patch-dependencies' phase." + (define delete-from-jsobject + (match-lambda + (('@ . alist) + (cons '@ (filter (match-lambda + ((k . _) + (not (member k absent)))) + alist))))) + + (with-atomic-json-file-replacement "package.json" + (lambda (pkg-meta) + (jsobject-update* + pkg-meta + `("devDependencies" ,delete-from-jsobject (@)) + `("dependencies" ,delete-from-jsobject (@)))))) + (define* (delete-lockfiles #:key inputs #:allow-other-keys) "Delete 'package-lock.json', 'yarn.lock', and 'npm-shrinkwrap.json', if they exist." -- cgit v1.2.3 From a2010ac21b020b31a723387d3ab82ef72ee6f64c Mon Sep 17 00:00:00 2001 From: zimoun Date: Tue, 4 Jan 2022 23:47:40 +0100 Subject: build: julia-build-system: Create 'Project.toml' file when missing. * guix/build/julia-build-system.scm (link-depot): Create 'Project.toml' file when missing using data provided by the user. (julia-create-package-toml): Remove from export. * doc/guix.texi (Build Systems): Update julia-build-system section. Signed-off-by: Efraim Flashner --- doc/guix.texi | 19 +++++++++---------- guix/build/julia-build-system.scm | 33 +++++++++++++++++++++------------ 2 files changed, 30 insertions(+), 22 deletions(-) (limited to 'guix/build') diff --git a/doc/guix.texi b/doc/guix.texi index 6996e17172..601212fb45 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -71,7 +71,7 @@ Copyright @copyright{} 2019 Kyle Andrews@* Copyright @copyright{} 2019 Alex Griffin@* Copyright @copyright{} 2019, 2020, 2021 Guillaume Le Vaillant@* Copyright @copyright{} 2020 Liliana Marie Prikler@* -Copyright @copyright{} 2019, 2020, 2021 Simon Tournier@* +Copyright @copyright{} 2019, 2020, 2021, 2022 Simon Tournier@* Copyright @copyright{} 2020 Wiktor Żelazny@* Copyright @copyright{} 2020 Damien Cassou@* Copyright @copyright{} 2020 Jakub Kądziołka@* @@ -8363,9 +8363,10 @@ julia} packages, which essentially is similar to running @samp{julia -e @env{JULIA_LOAD_PATH} contains the paths to all Julia package inputs. Tests are run by calling @code{/test/runtests.jl}. -The Julia package name is read from the file @file{Project.toml}. This -value can be overridden by passing the argument @code{#:julia-package-name} -(which must be correctly capitalized). +The Julia package name and uuid is read from the file +@file{Project.toml}. These values can be overridden by passing the +argument @code{#:julia-package-name} (which must be correctly +capitalized) or @code{#:julia-package-uuid}. Julia packages usually manage their binary dependencies via @code{JLLWrappers.jl}, a Julia package that creates a module (named @@ -8393,12 +8394,10 @@ MbedTLS package: (find-files "src/wrappers/" "\\.jl$")))) @end lisp -Some older packages that aren't using @file{Package.toml} yet, will require -this file to be created, too. The function @code{julia-create-package-toml} -helps creating the file. You need to pass the outputs and the source of the -package, its name (the same as the @code{file-name} parameter), the package -uuid, the package version, and a list of dependencies specified by their name -and their uuid. +Some older packages that aren't using @file{Project.toml} yet, will +require this file to be created, too. It is internally done if the +arguments @code{#:julia-package-name} and @code{#:julia-package-uuid} +are provided. @end defvr @defvr {Scheme Variable} maven-build-system diff --git a/guix/build/julia-build-system.scm b/guix/build/julia-build-system.scm index b4e0044567..03d669be64 100644 --- a/guix/build/julia-build-system.scm +++ b/guix/build/julia-build-system.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019, 2020 Nicolò Balzarotti ;;; Copyright © 2021 Jean-Baptiste Volatier -;;; Copyright © 2021 Simon Tournier +;;; Copyright © 2021, 2022 Simon Tournier ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,8 +27,8 @@ (define-module (guix build julia-build-system) #:use-module (ice-9 regex) #:use-module (ice-9 rdelim) #:use-module (ice-9 popen) + #:use-module (srfi srfi-1) #:export (%standard-phases - julia-create-package-toml julia-build)) ;; Commentary: @@ -138,6 +138,8 @@ (define* (check #:key tests? source inputs outputs julia-package-name (define* (link-depot #:key source inputs outputs julia-package-name julia-package-uuid #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) + (name+version (strip-store-file-name out)) + (version (last (string-split name+version #\-))) (package-name (or julia-package-name (project.toml->name "Project.toml"))) @@ -148,6 +150,14 @@ (define* (link-depot #:key source inputs outputs println(Base.version_slug(Base.UUID(\"~a\"), Base.SHA1(Pkg.GitTools.tree_hash(\".\"))))" uuid))) (slug (string-trim-right (get-string-all pipe)))) + ;; Few packages do not have the regular Project.toml file, then when they + ;; are propagated, dependencies do not find them and an raise error. + (unless (file-exists? "Project.toml") + (julia-create-package-toml (getcwd) + julia-package-name julia-package-uuid + version + #:file "Project.toml")) + ;; When installing a package, julia looks first at in the JULIA_DEPOT_PATH ;; for a path like packages/PACKAGE/XXXX ;; Where XXXX is a slug encoding the package UUID and SHA1 of the files @@ -157,17 +167,16 @@ (define* (link-depot #:key source inputs outputs (symlink package-dir (string-append out "/share/julia/packages/" package-name "/" slug)))) -(define (julia-create-package-toml outputs source - name uuid version - deps) - "Some packages are not using the new Package.toml dependency specifications. -Write this file manually, so that Julia can find its dependencies." +(define* (julia-create-package-toml location + name uuid version + #:optional + (deps '()) + #:key + (file "Project.toml")) + "Some packages are not using the new Project.toml dependency specifications. +Write this FILE manually, so that Julia can find its dependencies." (let ((f (open-file - (string-append - (assoc-ref outputs "out") - %package-path - (string-append - name "/Project.toml")) + (string-append location "/" file) "w"))) (display (string-append " -- cgit v1.2.3 From 7f8a896c5f3ecde60a19f244d5a407ec1033a08d Mon Sep 17 00:00:00 2001 From: Brendan Tildesley Date: Thu, 29 Apr 2021 20:33:08 +1000 Subject: utils: Fix wrap-script argument handling. * guix/build/utils.scm (wrap-script): Don't add (car cl) one too many times, cl its self contains it's car. Split the aguments string with string-tokenize to avoid leaving an empty string argument when there should be none. These two bugs seemed to be partially cancelling each other out so that scripts still worked when ran with no arguments. * tests/build-utils.scm: Adjust wrap-script to above changes. Add two tests to ensure the command line arguments appear identical to a script and its wrapped version. Signed-off-by: Maxim Cournoyer --- guix/build/utils.scm | 8 ++++---- tests/build-utils.scm | 57 +++++++++++++++++++++++++++++++++++++++++++++------ 2 files changed, 55 insertions(+), 10 deletions(-) (limited to 'guix/build') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 3beb7da67a..dd5a91f52f 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2020 Efraim Flashner ;;; Copyright © 2020, 2021 Maxim Cournoyer ;;; Copyright © 2021 Maxime Devos +;;; Copyright © 2021 Brendan Tildesley ;;; ;;; This file is part of GNU Guix. ;;; @@ -1462,10 +1463,9 @@ (define update-env `(let ((cl (command-line))) (apply execl ,interpreter (car cl) - (cons (car cl) - (append - ',(string-split args #\space) - cl)))))) + (append + ',(string-tokenize args char-set:graphic) + cl))))) (template (string-append prog ".XXXXXX")) (out (mkstemp! template)) (st (stat prog)) diff --git a/tests/build-utils.scm b/tests/build-utils.scm index 6b131c0af8..7f4f12ccc7 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2019 Ricardo Wurmus ;;; Copyright © 2021 Maxim Cournoyer ;;; Copyright © 2021 Maxime Devos +;;; Copyright © 2021 Brendan Tildesley ;;; ;;; This file is part of GNU Guix. ;;; @@ -167,9 +168,7 @@ (define-module (test build-utils) "/some/path:/some/other/path")))) '(let ((cl (command-line))) (apply execl "/anything/cabbage-bash-1.2.3/bin/sh" - (car cl) - (cons (car cl) - (append '("") cl))))) + (car cl) (append (quote ()) cl)))) script-contents) (call-with-temporary-directory (lambda (directory) @@ -208,8 +207,7 @@ (define-module (test build-utils) `(let ((cl (command-line))) (apply execl "/anything/cabbage-bash-1.2.3/bin/python3" (car cl) - (cons (car cl) - (append '("" "-and" "-args") cl))))) + (append '("-and" "-args") cl)))) script-contents) (call-with-temporary-directory (lambda (directory) @@ -243,6 +241,54 @@ (define-module (test build-utils) "/some/other/path"))) #f))))) +(define (arg-test bash-args) + (call-with-temporary-directory + (lambda (directory) + (let ((script-file-name (string-append directory "/bash-test.sh"))) + (call-with-output-file script-file-name + (lambda (port) + (display (string-append "\ +#!" (which "bash") bash-args " +echo \"$#$0$*${A}\"") + port))) + + (display "Unwrapped script contents:\n") + (call-with-input-file script-file-name + (lambda (port) (display (get-string-all port)))) + (newline) (newline) + (chmod script-file-name #o777) + (setenv "A" "A") + (let* ((run-script (lambda _ + (open-pipe* + OPEN_READ + script-file-name "1" "2" "3 3" "4"))) + (pipe (run-script)) + (unwrapped-output (get-string-all pipe))) + (close-pipe pipe) + + (wrap-script script-file-name `("A" = ("A\nA"))) + + (display "Wrapped script contents:\n") + (call-with-input-file script-file-name + (lambda (port) (display (get-string-all port)))) + (newline) (newline) + + (let* ((pipe (run-script)) + (wrapped-output (get-string-all pipe))) + (close-pipe pipe) + (display "./bash-test.sh 1 2 3\\ 3 4 # Output:\n") + (display unwrapped-output) (newline) + (display "./bash-test.sh 1 2 3\\ 3 4 # Output (wrapped):\n") + (display wrapped-output) (newline) + (string=? (string-append unwrapped-output "A\n") + wrapped-output))))))) + +(test-assert "wrap-script, argument handling" + (arg-test "")) + +(test-assert "wrap-script, argument handling, bash --norc" + (arg-test " --norc")) + (test-equal "substitute*, text contains a NUL byte, UTF-8" "c\0d" (with-fluids ((%default-port-encoding "UTF-8") @@ -287,5 +333,4 @@ (define-module (test build-utils) ("guile/bin" . ,(dirname (which "guile")))) "guile")))) - (test-end) -- cgit v1.2.3 From 0f71f55a60c94efe5c109233db6c92dbfba2bf82 Mon Sep 17 00:00:00 2001 From: Sarah Morgensen Date: Sat, 24 Jul 2021 23:12:04 -0700 Subject: build-system/gnu: Make gzip files writable before resetting timestamps. guix/build/gnu-build-system.scm (reset-gzip-timestamps): Ensure gzip files are writable before resetting their timestamps. Signed-off-by: Maxim Cournoyer --- guix/build/gnu-build-system.scm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'guix/build') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index d0f7413268..d84411c090 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -598,6 +598,8 @@ (define (process-directory directory) (string-suffix? ".tgz" file)) (gzip-file? file))) #:stat lstat))) + ;; Ensure the files are writable. + (for-each make-file-writable files) (for-each reset-gzip-timestamp files))) (match outputs -- cgit v1.2.3 From 97a6b4581ae68bfee3c907eb4c5af686052ea45f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 21 Jan 2022 16:32:44 +0100 Subject: compile: Really disable cross-module inlining and related features. This is a followup to d87a1ba6b8b2f08ba6898033353d7463355bd146. * guix/build/compile.scm (strip-keyword-arguments): Rename to... (clear-keyword-arguments): ... this, and set the value associated with each of KEYWORDS to #f. (optimizations-for-level): Adjust accordingly. --- guix/build/compile.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'guix/build') diff --git a/guix/build/compile.scm b/guix/build/compile.scm index 82761a2190..5b27b55d02 100644 --- a/guix/build/compile.scm +++ b/guix/build/compile.scm @@ -37,8 +37,8 @@ (define-module (guix build compile) ;;; ;;; Code: -(define (strip-keyword-arguments keywords args) ;XXX: copied from (guix utils) - "Remove all of the keyword arguments listed in KEYWORDS from ARGS." +(define (clear-keyword-arguments keywords args) + "Set to #f the value associated with each of the KEYWORDS in ARGS." (let loop ((args args) (result '())) (match args @@ -47,7 +47,7 @@ (define (strip-keyword-arguments keywords args) ;XXX: copied from (guix utils) (((? keyword? kw) arg . rest) (loop rest (if (memq kw keywords) - result + (cons* #f kw result) (cons* arg kw result)))) ((head . tail) (loop tail (cons head result)))))) @@ -82,7 +82,7 @@ (define %lightweight-optimizations ;; non-reproducible and more expensive builds, so we turn it off ;; here: ;; . - (strip-keyword-arguments '(#:inlinable-exports? #:resolve-free-vars? + (clear-keyword-arguments '(#:inlinable-exports? #:resolve-free-vars? #:cross-module-inlining?) (if (<= level 1) %lightweight-optimizations -- cgit v1.2.3 From 09b4d74bd352d40b45e081eaa094b086a42dad3d Mon Sep 17 00:00:00 2001 From: Reily Siegel Date: Sat, 15 Jan 2022 20:03:25 -0500 Subject: build-system/clojure: Exit with non-zero if tests fail. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/clojure-build-system.scm (check): Exit test process with a non-zero exit code if tests fail. Signed-off-by: Ludovic Courtès --- guix/build/clojure-build-system.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/clojure-build-system.scm b/guix/build/clojure-build-system.scm index d8f7c89f85..dd01f95de8 100644 --- a/guix/build/clojure-build-system.scm +++ b/guix/build/clojure-build-system.scm @@ -78,8 +78,11 @@ (define* (check #:key (for-each (lambda (jar) (eval-with-clojure `(do (apply require '(clojure.test ,@libs*)) - (apply clojure.test/run-tests - ',libs*)) + (if (clojure.test/successful? + (apply clojure.test/run-tests + ',libs*)) + (System/exit 0) + (System/exit 1))) (cons jar test-dirs))) jar-names))) #t) -- cgit v1.2.3 From 0f2df54f8397560e6e8473e2982c66af01d9cd0a Mon Sep 17 00:00:00 2001 From: Reily Siegel Date: Tue, 18 Jan 2022 13:17:24 -0500 Subject: build-system/clojure: Support compiling Java. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/clojure-build-system.scm (compile-java): New variable. (build): Copy classes compiled from Java and optionally Java sources to the final jar. (%standard-phases): Add compile-java phase before build. * guix/build/clojure-utils.scm (%java-source-dirs): New variable. (%java-compile-dir): New variable. * guix/build-system/clojure.scm (clojure-build): Include %java-source-dirs and %java-compile-dir. (builder): Include %java-source-dirs and %java-compile-dir. Signed-off-by: Ludovic Courtès --- guix/build-system/clojure.scm | 6 +++++- guix/build/clojure-build-system.scm | 36 +++++++++++++++++++++++++++++------- guix/build/clojure-utils.scm | 10 ++++++++++ 3 files changed, 44 insertions(+), 8 deletions(-) (limited to 'guix/build') diff --git a/guix/build-system/clojure.scm b/guix/build-system/clojure.scm index 634854cf1b..2a0713d297 100644 --- a/guix/build-system/clojure.scm +++ b/guix/build-system/clojure.scm @@ -107,8 +107,10 @@ (define* (clojure-build name inputs #:key source (source-dirs `',%source-dirs) + (java-source-dirs `',%java-source-dirs) (test-dirs `',%test-dirs) (compile-dir %compile-dir) + (java-compile-dir %java-compile-dir) (jar-names `',(package-name->jar-names name)) (main-class %main-class) @@ -142,9 +144,11 @@ (define builder #:source #+source #:source-dirs #$source-dirs + #:java-source-dirs #$java-source-dirs #:test-dirs #$test-dirs #:compile-dir #$compile-dir - + #:java-compile-dir #$java-compile-dir + #:jar-names #$jar-names #:main-class #$main-class #:omit-source? #$omit-source? diff --git a/guix/build/clojure-build-system.scm b/guix/build/clojure-build-system.scm index dd01f95de8..7d494078ea 100644 --- a/guix/build/clojure-build-system.scm +++ b/guix/build/clojure-build-system.scm @@ -34,8 +34,24 @@ (define-module (guix build clojure-build-system) ;; ;; Code: +(define* (compile-java #:key + java-source-dirs java-compile-dir + #:allow-other-keys) + "Compile java sources for use in clojure-build-system." + (let ((java-files (append-map (lambda (dir) + (find-files dir "\\.java$")) + java-source-dirs))) + (mkdir-p java-compile-dir) + (when (not (null? java-files)) + (apply invoke + "javac" + "-verbose" + "-d" java-compile-dir + java-files)))) + (define* (build #:key - source-dirs compile-dir + source-dirs java-source-dirs + compile-dir java-compile-dir jar-names main-class omit-source? aot-include aot-exclude #:allow-other-keys) @@ -46,19 +62,24 @@ (define* (build #:key #:all-list libs))) (mkdir-p compile-dir) (eval-with-clojure `(run! compile ',libs*) - source-dirs) + (cons* compile-dir + java-compile-dir + source-dirs)) (let ((source-dir-files-alist (map (lambda (dir) (cons dir (find-files* dir))) - source-dirs)) + (append source-dirs + java-source-dirs))) ;; workaround transitive compilation in Clojure (classes (filter (lambda (class) (any (cut compiled-from? class <>) libs*)) (find-files* compile-dir)))) - (for-each (cut create-jar <> (cons (cons compile-dir classes) - (if omit-source? - '() - source-dir-files-alist)) + (for-each (cut create-jar <> (cons* (cons compile-dir classes) + (cons java-compile-dir + (find-files* java-compile-dir)) + (if omit-source? + '() + source-dir-files-alist)) #:main-class main-class) jar-names) #t))) @@ -94,6 +115,7 @@ (define-with-docs install (define-with-docs %standard-phases "Standard build phases for clojure-build-system." (modify-phases %standard-phases@ant + (add-before 'build 'compile-java compile-java) (replace 'build build) (replace 'check check) (replace 'install install) diff --git a/guix/build/clojure-utils.scm b/guix/build/clojure-utils.scm index 8817cab52a..c5322141d3 100644 --- a/guix/build/clojure-utils.scm +++ b/guix/build/clojure-utils.scm @@ -32,8 +32,10 @@ (define-module (guix build clojure-utils) install-doc %source-dirs + %java-source-dirs %test-dirs %compile-dir + %java-compile-dir package-name->jar-names %main-class %omit-source? @@ -101,6 +103,10 @@ (define-with-docs %source-dirs "A default list of source directories." '("src/")) +(define-with-docs %java-source-dirs + "A default list of java source directories." + '()) + (define-with-docs %test-dirs "A default list of test directories." '("test/")) @@ -109,6 +115,10 @@ (define-with-docs %compile-dir "Default directory for holding class files." "classes/") +(define-with-docs %java-compile-dir + "Default directory for holding java class files." + "java-classes/") + (define (package-name->jar-names name) "Given NAME, a package name like \"foo-0.9.1b\", return the list of default jar names: (\"foo-0.9.1b.jar\" \"foo.jar\")." -- cgit v1.2.3