diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/derivations.scm | 8 | ||||
| -rw-r--r-- | tests/guix-system.sh | 15 | ||||
| -rw-r--r-- | tests/lint.scm | 97 | ||||
| -rw-r--r-- | tests/zlib.scm | 11 |
4 files changed, 110 insertions, 21 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm index f3aad1b906..36afd42d05 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -222,7 +222,7 @@ (build-derivations %store (list drv)) #f))) -(unless (force %http-server-socket) +(unless (http-server-can-listen?) (test-skip 1)) (test-assert "'download' built-in builder" (let ((text (random-text))) @@ -238,7 +238,7 @@ get-string-all) text)))))) -(unless (force %http-server-socket) +(unless (http-server-can-listen?) (test-skip 1)) (test-assert "'download' built-in builder, invalid hash" (with-http-server 200 "hello, world!" @@ -253,7 +253,7 @@ (build-derivations %store (list drv)) #f)))) -(unless (force %http-server-socket) +(unless (http-server-can-listen?) (test-skip 1)) (test-assert "'download' built-in builder, not found" (with-http-server 404 "not found" @@ -279,7 +279,7 @@ (build-derivations %store (list drv)) #f))) -(unless (force %http-server-socket) +(unless (http-server-can-listen?) (test-skip 1)) (test-assert "'download' built-in builder, check mode" ;; Make sure rebuilding the 'builtin:download' derivation in check mode diff --git a/tests/guix-system.sh b/tests/guix-system.sh index d575795ea0..31ee637133 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -53,6 +53,21 @@ else fi +cat > "$tmpfile"<<EOF +;; This is line 1, and the next one is line 2. + (operating-system +;; This is line 3, and there is no closing paren! +EOF + +if guix system vm "$tmpfile" 2> "$errorfile" +then + # This must not succeed. + exit 1 +else + grep "$tmpfile:4:1: missing closing paren" "$errorfile" +fi + + # Reporting of unbound variables. cat > "$tmpfile" <<EOF diff --git a/tests/lint.scm b/tests/lint.scm index 7610a91fd3..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) @@ -388,7 +389,7 @@ (check-home-page pkg))) "domain not found"))) -(test-skip (if (force %http-server-socket) 0 1)) +(test-skip (if (http-server-can-listen?) 0 1)) (test-assert "home-page: Connection refused" (->bool (string-contains @@ -399,7 +400,7 @@ (check-home-page pkg))) "Connection refused"))) -(test-skip (if (force %http-server-socket) 0 1)) +(test-skip (if (http-server-can-listen?) 0 1)) (test-equal "home-page: 200" "" (with-warnings @@ -409,7 +410,7 @@ (home-page (%local-url))))) (check-home-page pkg))))) -(test-skip (if (force %http-server-socket) 0 1)) +(test-skip (if (http-server-can-listen?) 0 1)) (test-assert "home-page: 200 but short length" (->bool (string-contains @@ -421,7 +422,7 @@ (check-home-page pkg)))) "suspiciously small"))) -(test-skip (if (force %http-server-socket) 0 1)) +(test-skip (if (http-server-can-listen?) 0 1)) (test-assert "home-page: 404" (->bool (string-contains @@ -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 @@ -510,7 +557,7 @@ (check-source-file-name pkg))) "file name should contain the package name")))) -(test-skip (if (force %http-server-socket) 0 1)) +(test-skip (if (http-server-can-listen?) 0 1)) (test-equal "source: 200" "" (with-warnings @@ -523,7 +570,7 @@ (sha256 %null-sha256)))))) (check-source pkg))))) -(test-skip (if (force %http-server-socket) 0 1)) +(test-skip (if (http-server-can-listen?) 0 1)) (test-assert "source: 200 but short length" (->bool (string-contains @@ -538,7 +585,7 @@ (check-source pkg)))) "suspiciously small"))) -(test-skip (if (force %http-server-socket) 0 1)) +(test-skip (if (http-server-can-listen?) 0 1)) (test-assert "source: 404" (->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 diff --git a/tests/zlib.scm b/tests/zlib.scm index f71609b7c5..5455240a71 100644 --- a/tests/zlib.scm +++ b/tests/zlib.scm @@ -57,16 +57,7 @@ (match (waitpid pid) ((_ . status) (and (zero? status) - - ;; PORT itself isn't closed but its underlying file - ;; descriptor must have been closed by 'gzclose'. - (catch 'system-error - (lambda () - (seek (fileno parent) 0 SEEK_CUR) - #f) - (lambda args - (= EBADF (system-error-errno args)))) - + (port-closed? parent) (bytevector=? received data)))))))))))) (test-end) |