guix-play/guix/build/julia-build-system.scm
zimoun 1f6ae9a8e0
build: julia-build-system: Fix corner-case for parallel tests.
* guix/build/julia-build-system.scm (check): Do not run parallel tests when
'--cores=1'.

Signed-off-by: Efraim Flashner <efraim@flashner.co.il>
2022-02-24 12:20:32 +02:00

224 lines
9.5 KiB
Scheme

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2020 Nicolò Balzarotti <nicolo@nixo.xyz>
;;; Copyright © 2021 Jean-Baptiste Volatier <jbv@pm.me>
;;; Copyright © 2021, 2022 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2022 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; 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 julia-build-system)
#:use-module ((guix build gnu-build-system) #:prefix gnu:)
#:use-module (guix build utils)
#:use-module (rnrs io ports)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 popen)
#:use-module (srfi srfi-1)
#:export (%standard-phases
julia-build))
;; Commentary:
;;
;; Builder-side code of the standard build procedure for Julia packages.
;;
;; Code:
(define (invoke-julia code)
(invoke "julia" "-e" code))
;; subpath where we store the package content
(define %package-path "/share/julia/loadpath/")
(define (project.toml->name file)
"Look for Julia package name in the TOML file FILE (usually named
Project.toml)."
(call-with-input-file file
(lambda (in)
(let loop ((line (read-line in 'concat)))
(if (eof-object? line)
#f
(let ((m (string-match "name\\s*=\\s*\"(.*)\"" line)))
(if m (match:substring m 1)
(loop (read-line in 'concat)))))))))
(define (project.toml->uuid file)
"Look for Julia package uuid in the TOML file FILE (usually named
Project.toml)."
(call-with-input-file file
(lambda (in)
(let loop ((line (read-line in 'concat)))
(if (eof-object? line)
#f
(let ((m (string-match "uuid\\s*=\\s*\"(.*)\"" line)))
(if m (match:substring m 1)
(loop (read-line in 'concat)))))))))
(define* (install #:key source inputs outputs julia-package-name
#:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(package-dir (string-append out %package-path
(or
julia-package-name
(project.toml->name "Project.toml")))))
(mkdir-p package-dir)
(copy-recursively (getcwd) package-dir)))
(define* (precompile #:key source inputs outputs julia-package-name
#:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(builddir (string-append out "/share/julia/"))
(package (or julia-package-name (project.toml->name "Project.toml"))))
(mkdir-p builddir)
;; With a patch, SOURCE_DATE_EPOCH is honored
(setenv "SOURCE_DATE_EPOCH" "1")
(setenv "JULIA_DEPOT_PATH" builddir)
;; Add new package dir to the load path.
(setenv "JULIA_LOAD_PATH"
(string-append builddir "loadpath/" ":"
(or (getenv "JULIA_LOAD_PATH")
"")))
;; Actual precompilation:
(invoke-julia
;; When using Julia as a user, Julia writes precompile cache to the first
;; entry of the DEPOT_PATH list (by default, the home dir). We want to
;; write it to the store, so let's push the store path as the first
;; element of DEPOT_PATH. Once the cache file exists, this hack is not
;; needed anymore (like in the check phase). If the user install new
;; packages, those will be installed and precompiled in the home dir.
(string-append "pushfirst!(DEPOT_PATH, pop!(DEPOT_PATH)); using "
package))))
(define* (check #:key tests? source inputs outputs julia-package-name
parallel-tests? #:allow-other-keys)
(when tests?
(let* ((out (assoc-ref outputs "out"))
(package (or julia-package-name (project.toml->name "Project.toml")))
(builddir (string-append out "/share/julia/"))
(job-count (if parallel-tests?
(parallel-job-count)
1))
;; The --procs argument of Julia *adds* extra processors rather
;; than specify the exact count to use, so zero must be specified
;; to disable parallel processing...
(additional-procs (max 0 (1- job-count))))
;; With a patch, SOURCE_DATE_EPOCH is honored
(setenv "SOURCE_DATE_EPOCH" "1")
(setenv "JULIA_DEPOT_PATH" builddir)
(setenv "JULIA_LOAD_PATH"
(string-append builddir "loadpath/" ":"
(or (getenv "JULIA_LOAD_PATH")
"")))
(setenv "JULIA_CPU_THREADS" (number->string job-count))
(setenv "HOME" "/tmp")
(apply invoke "julia"
`("--depwarn=yes"
,@(if (and parallel-tests? (< 0 additional-procs))
;; XXX: ... but '--procs' doesn't accept 0 as a valid
;; value, so just omit the argument entirely.
(list (string-append "--procs="
(number->string additional-procs)))
'())
,(string-append builddir "loadpath/"
package "/test/runtests.jl"))))))
(define* (link-depot #:key source inputs outputs
julia-package-name julia-package-uuid
julia-package-dependencies #: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")))
(package-dir (string-append out %package-path package-name))
(uuid (or julia-package-uuid (project.toml->uuid "Project.toml")))
(pipe (open-pipe* OPEN_READ "julia" "-e"
(format #f "using Pkg;
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
julia-package-dependencies
#: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
;; Here we create a link with the correct path to enable julia to find the
;; package
(mkdir-p (string-append out "/share/julia/packages/" package-name))
(symlink package-dir (string-append out "/share/julia/packages/"
package-name "/" slug))))
(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 location "/" file)
"w")))
(display (string-append
"
name = \"" name "\"
uuid = \"" uuid "\"
version = \"" version "\"
") f)
(when (not (null? deps))
(display "[deps]\n" f)
(for-each (match-lambda
((name . uuid)
(display (string-append name " = \"" uuid "\"\n")
f)))
deps))
(close-port f)))
(define %standard-phases
(modify-phases gnu:%standard-phases
(delete 'check) ; tests must be run after installation
(replace 'install install)
(add-after 'install 'precompile precompile)
(add-after 'unpack 'link-depot link-depot)
(add-after 'install 'check check)
;; TODO: In the future we could add a "system-image-generation" phase
;; where we use PackageCompiler.jl to speed up package loading times
(delete 'configure)
(delete 'bootstrap)
(delete 'patch-usr-bin-file)
(delete 'build)))
(define* (julia-build #:key inputs julia-package-name julia-package-uuid
julia-package-dependencies
(phases %standard-phases)
#:allow-other-keys #:rest args)
"Build the given Julia package, applying all of PHASES in order."
(apply gnu:gnu-build
#:inputs inputs #:phases phases
#:julia-package-name julia-package-name
#:julia-package-uuid julia-package-uuid
#:julia-package-dependencies julia-package-dependencies
args))