GNU bug report logs - #26346
[PATCH] asdf-build-system improvements.

Previous Next

Full log

View this message in rfc822 format

From: Andy Patterson <ajpatter <at> uwaterloo.ca>
To: 26346 <at> debbugs.gnu.org
Cc: Andy Patterson <ajpatter <at> uwaterloo.ca>
Subject: bug#26346: [PATCH 18/20] build-system/asdf: Handle tests defined in external systems.
Date: Sat,  8 Apr 2017 23:43:31 -0400

* guix/build-system/asdf.scm (asdf-build): Add a #:test-asd-file argument.
[builder]: Pass it to the build system.
(package-with-build-system)[transform]: Strip it
from source systems' arguments.
* guix/build/asdf-build-system.scm (check): Pass the fully qualified path to
it on to the test-system procedure.
* guix/build/lisp-utils.scm (test-system): Load the file, or otherwise one of
the often used names for it, before running the tests.  Adjust the docstring
accordingly.
---
 guix/build-system/asdf.scm       |  4 +++-
 guix/build/asdf-build-system.scm |  8 ++++++--
 guix/build/lisp-utils.scm        | 18 +++++++++++++++---
 3 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm
index 6709238e1..d992624a9 100644
--- a/guix/build-system/asdf.scm
+++ b/guix/build-system/asdf.scm
@@ -199,7 +199,7 @@ set up using CL source package conventions."
        (define base-arguments
          (if target-is-source?
              (strip-keyword-arguments
-              '(#:tests? #:asd-file #:lisp #:asd-system-name)
+              '(#:tests? #:asd-file #:lisp #:asd-system-name #:test-asd-file)
               (package-arguments pkg))
              (package-arguments pkg)))
 
@@ -266,6 +266,7 @@ set up using CL source package conventions."
                   (tests? #t)
                   (asd-file #f)
                   (asd-system-name #f)
+                  (test-asd-file #f)
                   (phases '(@ (guix build asdf-build-system)
                               %standard-phases))
                   (search-paths '())
@@ -296,6 +297,7 @@ set up using CL source package conventions."
                                    (source source))
                        #:asd-file ,(or asd-file (string-append system-name ".asd"))
                        #:asd-system-name ,system-name
+                       #:test-asd-file ,test-asd-file
                        #:system ,system
                        #:tests? ,tests?
                        #:phases ,phases
diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm
index 1e0a2f6de..c5e820a00 100644
--- a/guix/build/asdf-build-system.scm
+++ b/guix/build/asdf-build-system.scm
@@ -131,12 +131,16 @@ valid."
   #t)
 
 (define* (check #:key tests? outputs inputs asd-file asd-system-name
+                test-asd-file
                 #:allow-other-keys)
   "Test the system."
   (let* ((out (library-output outputs))
-         (asd-file (source-asd-file out asd-system-name asd-file)))
+         (asd-file (source-asd-file out asd-system-name asd-file))
+         (test-asd-file
+          (and=> test-asd-file
+                 (cut source-asd-file out asd-system-name <>))))
     (if tests?
-        (test-system asd-system-name asd-file)
+        (test-system asd-system-name asd-file test-asd-file)
         (format #t "test suite not run~%")))
   #t)
 
diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm
index cadbf4e6b..6d9341bb2 100644
--- a/guix/build/lisp-utils.scm
+++ b/guix/build/lisp-utils.scm
@@ -184,12 +184,24 @@ asdf:system-depends-on.  First load the system's ASD-FILE."
           `(:lib ,(string-append system ".a"))
           '())))
 
-(define (test-system system asd-file)
-  "Use a lisp implementation to test SYSTEM using asdf.  Load ASD-FILE first."
+(define (test-system system asd-file test-asd-file)
+  "Use a lisp implementation to test SYSTEM using asdf.  Load ASD-FILE first.
+Also load TEST-ASD-FILE if necessary."
   (lisp-eval-program
    `((require :asdf)
      (let ((*package* (find-package :asdf)))
-       (load ,asd-file))
+       (load ,asd-file)
+       ,@(if test-asd-file
+             `((load ,test-asd-file))
+             ;; Try some likely files.
+             (map (lambda (file)
+                    `(when (uiop:file-exists-p ,file)
+                       (load ,file)))
+                  (list
+                   (string-append system "-tests.asd")
+                   (string-append system "-test.asd")
+                   "tests.asd"
+                   "test.asd"))))
      (asdf:test-system ,system))))
 
 (define (string->lisp-keyword . strings)
-- 
2.12.2

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.