@@ -9022,13 +9022,22 @@ code and that are so lean that they don't even have a makefile, let alone a
@file{configure} script. It compiles Scheme code using @command{guild
compile} (@pxref{Compilation,,, guile, GNU Guile Reference Manual}) and
installs the @file{.scm} and @file{.go} files in the right place. It also
-installs documentation.
+installs documentation and runs SRFI-64 test suites.
+
+Test suites cannot be found automatically; the location of the test
+suite can be set with the @code{#:test-script} argument (as a string).
+If there are multiple test scripts, this argument can be set to a staged
+list of locations. Sometimes some tests need to be skipped, if so,
+@code{#:test-arguments} can be a staged list with extra arguments to
+pass to the test driver (see @code{test-driver.scm --help} for details).
This build system supports cross-compilation by using the
@option{--target} option of @samp{guild compile}.
-Packages built with @code{guile-build-system} must provide a Guile package in
-their @code{native-inputs} field.
+Packages built with @code{guile-build-system} must provide a Guile
+package in their @code{native-inputs} field. Additionally, if
+@code{#:test-script} is used, a test driver (usually
+@code{guile-test-driver}) must be provided.
@end defvr
@defvr {Scheme Variable} julia-build-system
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018-2019, 2021-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -78,6 +79,9 @@ (define %compile-flags
(define* (guile-build name inputs
#:key source
+ (tests? #true)
+ (test-script #false)
+ (test-arguments ''())
(guile #f)
(phases '%standard-phases)
(outputs '("out"))
@@ -98,6 +102,9 @@ (define builder
(guile-build #:name #$name
#:source #+source
+ #:tests? #$tests?
+ #:test-script #$test-script
+ #:test-arguments #$test-arguments
#:source-directory #$source-directory
#:scheme-file-regexp #$scheme-file-regexp
#:not-compiled-file-regexp #$not-compiled-file-regexp
@@ -122,6 +129,9 @@ (define* (guile-cross-build name
build-inputs target-inputs host-inputs
(guile #f)
source
+ (tests? #false)
+ (test-script #false)
+ (test-arguments ''())
(outputs '("out"))
(search-paths '())
(native-search-paths '())
@@ -149,6 +159,9 @@ (define %outputs
#$(outputs->gexp outputs))
(guile-build #:source #+source
+ #:tests? #$tests?
+ #:test-script #$test-script
+ #:test-arguments #$test-arguments
#:system #$system
#:target #$target
#:outputs %outputs
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,8 +20,10 @@
(define-module (guix build guile-build-system)
#:use-module ((guix build gnu-build-system) #:prefix gnu:)
#:use-module (guix build utils)
+ #:use-module (rnrs exceptions)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim)
@@ -29,7 +32,8 @@ (define-module (guix build guile-build-system)
#:use-module (guix build utils)
#:export (target-guile-effective-version
%standard-phases
- guile-build))
+ guile-build
+ guile-check))
(define* (target-guile-effective-version #:optional guile)
"Return the effective version of GUILE or whichever 'guile' is in $PATH.
@@ -201,6 +205,42 @@ (define* (build #:key outputs inputs native-inputs
source-files))
#t))
+(define* (guile-check #:key tests? test-script (test-arguments '())
+ (source-directory ".")
+ native-inputs inputs
+ #:allow-other-keys)
+ (when tests?
+ ;; Let Guile find the source code of newly compiled modules,
+ ;; otherwise the modules won't be found even if Guile knows
+ ;; where the compiled code is.
+ (setenv "GUILE_LOAD_PATH"
+ (string-append source-directory
+ (match (getenv "GUILE_LOAD_PATH")
+ (#f "")
+ (path (string-append ":" path)))))
+ (for-each
+ (lambda (test-script)
+ (guard (c ((invoke-error? c)
+ (when (equal? (list (invoke-error-exit-status c)
+ (invoke-error-term-signal c)
+ (invoke-error-stop-signal c))
+ '(127 #false #false))
+ (display "hint: Make sure 'guile-test-driver' is in\
+ 'native-inputs'.\n"
+ (current-error-port)))
+ (raise-continuable c)))
+ (apply invoke "test-driver.scm"
+ (string-append "--test-name=" test-script) test-arguments)))
+ (match test-script
+ ;; Tests can be separated over multiple files.
+ ((? list? test-scripts) test-scripts)
+ ((? string? test-script) (list test-script))
+ (#false
+ (format (current-error-port)
+ "warning: location of test suite is unknown; not running\
+ tests~%")
+ '())))))
+
(define* (install-documentation #:key outputs
(documentation-file-regexp
%documentation-file-regexp)
@@ -222,7 +262,7 @@ (define %standard-phases
(replace 'build build)
(add-after 'build 'install-documentation
install-documentation)
- (delete 'check)
+ (replace 'check guile-check)
(delete 'strip)
(delete 'validate-runpath)
(delete 'install)))