From 002c57c6f7d51077e4796106177456ebb564e25a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 12 Apr 2015 23:14:19 +0200
Subject: [PATCH] lint: Add a 'derivation' checker.

* guix/scripts/lint.scm (check-derivation): New procedure.
  (%checkers): Add 'derivation' checker.
* tests/lint.scm ("derivation: invalid arguments"): New test.
---
 guix/scripts/lint.scm | 27 +++++++++++++++++++++++++++
 tests/lint.scm        | 10 ++++++++++
 2 files changed, 37 insertions(+)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 699311a6a9..cced1bda66 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -19,6 +19,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix scripts lint)
+  #:use-module (guix store)
   #:use-module (guix base32)
   #:use-module (guix download)
   #:use-module (guix ftp-client)
@@ -32,6 +33,8 @@ (define-module (guix scripts lint)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 format)
   #:use-module (web uri)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module ((guix build download)
                 #:select (maybe-expand-mirrors
                           open-connection-for-uri))
@@ -49,6 +52,7 @@ (define-module (guix scripts lint)
             check-inputs-should-be-native
             check-patch-file-names
             check-synopsis-style
+            check-derivation
             check-home-page
             check-source))
 
@@ -440,6 +444,25 @@ (define (check-source package)
              (append-map (cut maybe-expand-mirrors <> %mirrors)
                          uris))))))
 
+(define (check-derivation package)
+  "Emit a warning if we fail to compile PACKAGE to a derivation."
+  (catch #t
+    (lambda ()
+      (guard (c ((nix-protocol-error? c)
+                 (emit-warning package
+                               (format #f (_ "failed to create derivation: ~a")
+                                       (nix-protocol-error-message c))))
+                ((message-condition? c)
+                 (emit-warning package
+                               (format #f (_ "failed to create derivation: ~a")
+                                       (condition-message c)))))
+        (with-store store
+          (package-derivation store package))))
+    (lambda args
+      (emit-warning package
+                    (format #f (_ "failed to create derivation: ~s~%")
+                            args)))))
+
 
 
 ;;;
@@ -472,6 +495,10 @@ (define %checkers
      (name        'source)
      (description "Validate source URLs")
      (check       check-source))
+   (lint-checker
+     (name        'derivation)
+     (description "Report failure to compile a package to a derivation")
+     (check       check-derivation))
    (lint-checker
      (name        'synopsis)
      (description "Validate package synopses")
diff --git a/tests/lint.scm b/tests/lint.scm
index ab89a58ae6..2807eba1cc 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -319,6 +319,16 @@ (define-syntax-rule (with-warnings body ...)
          (check-patch-file-names pkg)))
      "patch not found")))
 
+(test-assert "derivation: invalid arguments"
+  (->bool
+   (string-contains
+    (with-warnings
+      (let ((pkg (dummy-package "x"
+                   (arguments
+                    '(#:imported-modules (invalid-module))))))
+        (check-derivation pkg)))
+    "failed to create derivation")))
+
 (test-assert "home-page: wrong home-page"
   (->bool
    (string-contains