From 950d2ea414f3ce11e68f059ccef7f5e6a6181778 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 5 Mar 2015 22:16:01 +0100
Subject: lint: Add tests for the 'source' checker.

* guix/scripts/lint.scm (check-source): Export.
* tests/lint.scm (%null-sha256): New procedure.
  ("source: 200", "source: 404"): New tests.
---
 guix/scripts/lint.scm |  3 ++-
 tests/lint.scm        | 33 +++++++++++++++++++++++++++++++++
 2 files changed, 35 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index fef05635b3..69717b6317 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -47,7 +47,8 @@ (define-module (guix scripts lint)
             check-inputs-should-be-native
             check-patches
             check-synopsis-style
-            check-home-page))
+            check-home-page
+            check-source))
 
 
 ;;;
diff --git a/tests/lint.scm b/tests/lint.scm
index e0b1e67989..c0599224b7 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -46,6 +46,11 @@ (define %local-url
   (string-append "http://localhost:" (number->string %http-server-port)
                  "/foo/bar"))
 
+(define %null-sha256
+  ;; SHA256 of the empty string.
+  (base32
+   "0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73"))
+
 (define %http-server-socket
   ;; Socket used by the Web server.
   (catch 'system-error
@@ -363,6 +368,34 @@ (define-syntax-rule (with-warnings body ...)
           (check-home-page pkg))))
     "not reachable: 404")))
 
+(test-skip (if %http-server-socket 0 1))
+(test-equal "source: 200"
+  ""
+  (with-warnings
+   (with-http-server 200
+     (let ((pkg (package
+                  (inherit (dummy-package "x"))
+                  (source (origin
+                            (method url-fetch)
+                            (uri %local-url)
+                            (sha256 %null-sha256))))))
+       (check-source pkg)))))
+
+(test-skip (if %http-server-socket 0 1))
+(test-assert "source: 404"
+  (->bool
+   (string-contains
+    (with-warnings
+      (with-http-server 404
+        (let ((pkg (package
+                     (inherit (dummy-package "x"))
+                     (source (origin
+                               (method url-fetch)
+                               (uri %local-url)
+                               (sha256 %null-sha256))))))
+          (check-source pkg))))
+    "not reachable: 404")))
+
 (test-end "lint")
 
 
-- 
cgit v1.2.3