build-system/r: Use invoke.

* guix/build/r-build-system.scm (invoke-r): Use invoke.
(pipe-to-r): Raise invoke-error on non-zero return value.
(check): Unconditionally return #t.

1 files changed, 17 insertions, 10 deletions

diff --git a/guix/build/r-build-system.scm b/guix/build/r-build-system.scm
index 5e18939d22..4d8ac5b479 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, 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2015, 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +24,7 @@
   #:use-module (ice-9 popen)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-35)
   #:export (%standard-phases
             r-build))
 
@@ -34,12 +35,19 @@
 ;; Code:
 
 (define (invoke-r command params)
-  (zero? (apply system* "R" "CMD" command params)))
+  (apply invoke "R" "CMD" command params))
 
 (define (pipe-to-r command params)
   (let ((port (apply open-pipe* OPEN_WRITE "R" params)))
     (display command port)
-    (zero? (status:exit-val (close-pipe port)))))
+    (let ((code (status:exit-val (close-pipe port))))
+      (unless (zero? code)
+        (raise (condition ((@@ (guix build utils) &invoke-error)
+                           (program "R")
+                           (arguments (string-append params " " command))
+                           (exit-status (status:exit-val code))
+                           (term-signal (status:term-sig code))
+                           (stop-signal (status:stop-sig code)))))))))
 
 (define (generate-site-path inputs)
   (string-join (map (match-lambda
@@ -68,13 +76,12 @@
          (pkg-name  (car (scandir libdir (negate (cut member <> '("." ".."))))))
          (testdir   (string-append libdir pkg-name "/" test-target))
          (site-path (string-append libdir ":" (generate-site-path inputs))))
-    (if (and tests? (file-exists? testdir))
-        (begin
-          (setenv "R_LIBS_SITE" site-path)
-          (pipe-to-r (string-append "tools::testInstalledPackage(\"" pkg-name "\", "
-                                    "lib.loc = \"" libdir "\")")
-                     '("--no-save" "--slave")))
-        #t)))
+    (when (and tests? (file-exists? testdir))
+      (setenv "R_LIBS_SITE" site-path)
+      (pipe-to-r (string-append "tools::testInstalledPackage(\"" pkg-name "\", "
+                                "lib.loc = \"" libdir "\")")
+                 '("--no-save" "--slave")))
+    #t))
 
 (define* (install #:key outputs inputs (configure-flags '())
                   #:allow-other-keys)