summaryrefslogtreecommitdiff
path: root/tests/lint.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-10-12 23:26:50 +0200
committerLudovic Courtès <ludo@gnu.org>2017-10-12 23:47:48 +0200
commit61f28fe7e96e022055d3568956ed23c7a48e3548 (patch)
treef4c7e372772d5479e12ef40f717840ce4cf97951 /tests/lint.scm
parent6ea10db973d861cd8774938e40151c0f8b2d266f (diff)
lint: 'home-page' checker reports permanent redirects.
* guix/scripts/lint.scm (probe-uri): Add special case for HTTP 301. (validate-uri): Likewise. * tests/lint.scm ("home-page: 301, invalid") ("home-page: 301 -> 200", "home-page: 301 -> 404") ("source: 301 -> 200", "source: 301 -> 404"): New tests.
Diffstat (limited to 'tests/lint.scm')
-rw-r--r--tests/lint.scm83
1 files changed, 83 insertions, 0 deletions
diff --git a/tests/lint.scm b/tests/lint.scm
index d7254bc070..1d0fc4708c 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -37,6 +37,7 @@
#:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
+ #:use-module (web uri)
#:use-module (web server)
#:use-module (web server http)
#:use-module (web response)
@@ -433,6 +434,52 @@
(check-home-page pkg))))
"not reachable: 404")))
+(test-skip (if (http-server-can-listen?) 0 1))
+(test-assert "home-page: 301, invalid"
+ (->bool
+ (string-contains
+ (with-warnings
+ (with-http-server 301 %long-string
+ (let ((pkg (package
+ (inherit (dummy-package "x"))
+ (home-page (%local-url)))))
+ (check-home-page pkg))))
+ "invalid permanent redirect")))
+
+(test-skip (if (http-server-can-listen?) 0 1))
+(test-assert "home-page: 301 -> 200"
+ (->bool
+ (string-contains
+ (with-warnings
+ (with-http-server 200 %long-string
+ (let ((initial-url (%local-url)))
+ (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+ (with-http-server (301 `((location
+ . ,(string->uri initial-url))))
+ ""
+ (let ((pkg (package
+ (inherit (dummy-package "x"))
+ (home-page (%local-url)))))
+ (check-home-page pkg)))))))
+ "permanent redirect")))
+
+(test-skip (if (http-server-can-listen?) 0 1))
+(test-assert "home-page: 301 -> 404"
+ (->bool
+ (string-contains
+ (with-warnings
+ (with-http-server 404 "booh!"
+ (let ((initial-url (%local-url)))
+ (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+ (with-http-server (301 `((location
+ . ,(string->uri initial-url))))
+ ""
+ (let ((pkg (package
+ (inherit (dummy-package "x"))
+ (home-page (%local-url)))))
+ (check-home-page pkg)))))))
+ "not reachable: 404")))
+
(test-assert "source-file-name"
(->bool
(string-contains
@@ -553,6 +600,42 @@
(check-source pkg))))
"not reachable: 404")))
+(test-skip (if (http-server-can-listen?) 0 1))
+(test-equal "source: 301 -> 200"
+ ""
+ (with-warnings
+ (with-http-server 200 %long-string
+ (let ((initial-url (%local-url)))
+ (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+ (with-http-server (301 `((location . ,(string->uri initial-url))))
+ ""
+ (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-can-listen?) 0 1))
+(test-assert "source: 301 -> 404"
+ (->bool
+ (string-contains
+ (with-warnings
+ (with-http-server 404 "booh!"
+ (let ((initial-url (%local-url)))
+ (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+ (with-http-server (301 `((location . ,(string->uri initial-url))))
+ ""
+ (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-assert "mirror-url"
(string-null?
(with-warnings