02/03: lint: Report patches that cannot be found.

[Ludovic Courtès]

civodul pushed a commit to branch core-updates
in repository guix.

commit b210b35d61e41ab5c3ad923eacc8ecbd58d3edca
Author: Ludovic Courtès <address@hidden>
Date:   Fri Apr 10 10:27:26 2015 +0200

    lint: Report patches that cannot be found.
    
    * guix/scripts/lint.scm (check-patch-file-names): Wrap body in 'guard'.
    * tests/lint.scm ("patches: not found"): New test.
---
 guix/scripts/lint.scm |   44 +++++++++++++++++++++++++-------------------
 tests/lint.scm        |   15 +++++++++++++++
 2 files changed, 40 insertions(+), 19 deletions(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 543b3dd..699311a 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -41,6 +41,8 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
   #:export (guix-lint
             check-description-style
@@ -349,25 +351,29 @@ warning for PACKAGE mentionning the FIELD."
                     'home-page)))))
 
 (define (check-patch-file-names package)
-  ;; Emit a warning if the patches requires by PACKAGE are badly named.
-  (let ((patches   (and=> (package-source package) origin-patches))
-        (name      (package-name package))
-        (full-name (package-full-name package)))
-    (when (and patches
-               (any (match-lambda
-                     ((? string? patch)
-                      (let ((file (basename patch)))
-                        (not (or (eq? (string-contains file name) 0)
-                                 (eq? (string-contains file full-name)
-                                      0)))))
-                     (_
-                      ;; This must be an <origin> or something like that.
-                      #f))
-                    patches))
-      (emit-warning package
-                    (_ "file names of patches should start with \
+  "Emit a warning if the patches requires by PACKAGE are badly named or if the
+patch could not be found."
+  (guard (c ((message-condition? c)               ;raised by 'search-patch'
+             (emit-warning package (condition-message c)
+                           'patch-file-names)))
+    (let ((patches   (and=> (package-source package) origin-patches))
+          (name      (package-name package))
+          (full-name (package-full-name package)))
+      (when (and patches
+                 (any (match-lambda
+                        ((? string? patch)
+                         (let ((file (basename patch)))
+                           (not (or (eq? (string-contains file name) 0)
+                                    (eq? (string-contains file full-name)
+                                         0)))))
+                        (_
+                         ;; This must be an <origin> or something like that.
+                         #f))
+                      patches))
+        (emit-warning package
+                      (_ "file names of patches should start with \
 the package name")
-                    'patch-file-names))))
+                      'patch-file-names)))))
 
 (define (escape-quotes str)
   "Replace any quote character in STR by an escaped quote character."
@@ -456,7 +462,7 @@ descriptions maintained upstream."
      (check       check-inputs-should-be-native))
    (lint-checker
      (name        'patch-file-names)
-     (description "Validate file names of patches")
+     (description "Validate file names and availability of patches")
      (check       check-patch-file-names))
    (lint-checker
      (name        'home-page)
diff --git a/tests/lint.scm b/tests/lint.scm
index 047f278..ab89a58 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -304,6 +304,21 @@ requests."
          (check-patch-file-names pkg)))
      "file names of patches should start with the package name")))
 
+(test-assert "patches: not found"
+  (->bool
+   (string-contains
+     (with-warnings
+       (let ((pkg (dummy-package "x"
+                    (source
+                     (origin
+                       (method url-fetch)
+                       (uri "someurl")
+                       (sha256 "somesha")
+                       (patches
+                        (list (search-patch 
"this-patch-does-not-exist!"))))))))
+         (check-patch-file-names pkg)))
+     "patch not found")))
+
 (test-assert "home-page: wrong home-page"
   (->bool
    (string-contains