From patchwork Sat Feb 20 22:00:30 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: M X-Patchwork-Id: 27169 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id AD17327BC49; Sat, 20 Feb 2021 22:02:12 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, FREEMAIL_FROM,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS,T_DKIM_INVALID,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 5D2A827BC48 for ; Sat, 20 Feb 2021 22:02:11 +0000 (GMT) Received: from localhost ([::1]:59014 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lDaKI-0003AO-FG for patchwork@mira.cbaines.net; Sat, 20 Feb 2021 17:02:10 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:45588) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lDaKA-000391-OU for guix-patches@gnu.org; Sat, 20 Feb 2021 17:02:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:41490) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lDaKA-0001yR-Gg for guix-patches@gnu.org; Sat, 20 Feb 2021 17:02:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1lDaKA-0007XN-Dk for guix-patches@gnu.org; Sat, 20 Feb 2021 17:02:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#46668] [PATCH]: tests: do not hard code HTTP ports Resent-From: Maxime Devos Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 20 Feb 2021 22:02:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 46668 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 46668@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.161385846828908 (code B ref -1); Sat, 20 Feb 2021 22:02:02 +0000 Received: (at submit) by debbugs.gnu.org; 20 Feb 2021 22:01:08 +0000 Received: from localhost ([127.0.0.1]:53036 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lDaJH-0007WB-Jc for submit@debbugs.gnu.org; Sat, 20 Feb 2021 17:01:08 -0500 Received: from lists.gnu.org ([209.51.188.17]:59690) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lDaJE-0007W2-HZ for submit@debbugs.gnu.org; Sat, 20 Feb 2021 17:01:06 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:45466) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lDaJD-0002kC-Ga for guix-patches@gnu.org; Sat, 20 Feb 2021 17:01:04 -0500 Received: from xavier.telenet-ops.be ([2a02:1800:120:4::f00:14]:54034) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lDaJ9-0001WP-F1 for guix-patches@gnu.org; Sat, 20 Feb 2021 17:01:03 -0500 Received: from ptr-bvsjgyjmffd7q9timvx.18120a2.ip6.access.telenet.be ([IPv6:2a02:1811:8c09:9d00:aaf1:9810:a0b8:a55d]) by xavier.telenet-ops.be with bizsmtp id Xa0l2400C0mfAB401a0m9t; Sat, 20 Feb 2021 23:00:46 +0100 Message-ID: <1728b9290c1b0e248b71c8b35623939853895a7f.camel@telenet.be> From: Maxime Devos Date: Sat, 20 Feb 2021 23:00:30 +0100 User-Agent: Evolution 3.34.2 MIME-Version: 1.0 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=telenet.be; s=r21; t=1613858446; bh=rZIq8pQeUkeuXj56FRLGO6OJEXP0Hd99EFL7wfL1o4U=; h=Subject:From:To:Date; b=sO0GqKCKD0uSwn5CKoZN+xuHCQbkAtWjf7sQPKCsmM2AU87mu5AoPd/xYzKAwTIFn 2nQu3mAhH3QgN4RzCHSmQQeOLU7Oo8EpG8rsNtRpHdB7P01e6BN4KefNY+7I7vwlTl b2PvEgOUlt2a6WU+liKeRo69V/KZovIs8yU6nRUe9D9ftSqLl7F6UUwmOvxPsFyKDE nsFllyGduOpd4vd/5GeVbqyvJzK18kGyO3I2JIVLYh2diFhVW/L8kw4p+6VY8d0h0N T4MsQ2V9RnfJYQy8/KiR0zHNq/OGvPv925KnQbu0+27Y46NaNbXSgGaQDiwe21u11b MTnPL4nJTOw1g== Received-SPF: pass client-ip=2a02:1800:120:4::f00:14; envelope-from=maximedevos@telenet.be; helo=xavier.telenet-ops.be X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_LOW=-0.7, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches Hi Guix, I encountered a ‘Cannot listen to port: is bound’ error or something like that when testing some changes to the substituter. I'm not sure yet what the cause is, but this patch should eliminate some potential trouble, by not hard-coding ports in tests that require a temporary http server, and instead automatically assigning a free port. Greetings, Maxime From 6a5ea1f1a9155e23e46a38577adf74527ba50b2c Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sat, 20 Feb 2021 22:04:59 +0100 Subject: [PATCH] tests: do not hard code HTTP ports Previously, test cases could fail if some process was listening at a hard-coded port. This patch eliminates most of these potential failures, by automatically assigning an unbound port. This should allow for building multiple guix trees in parallel outside a build container, though this is currently untested. The test "home-page: Connection refused" in tests/lint.scm still hardcodes port 9999, however. * guix/tests/http.scm (http-server-can-listen?): remove now unused procedure. (%http-server-port): default to port 0, meaning the OS will automatically choose a port. (open-http-server-socket): remove the false statement claiming this procedure is exported and also return the allocated port number. (%local-url): raise an error if the port is obviously unbound. (call-with-http-server): set %http-server-port to the allocated port while the thunk is called. * tests/derivations.scm: adjust test cases to use automatically assign a port. As there is no risk of a port conflict now, do not make any tests conditional upon 'http-server-can-listen?' anymore. * tests/elpa.scm: likewise. * tests/lint.scm: likewise, and add a TODO comment about a port that is still hard-coded. * tests/texlive.scm: likewise. --- guix/tests/http.scm | 39 +++++---- tests/derivations.scm | 41 ++++------ tests/elpa.scm | 3 - tests/lint.scm | 179 +++++++++++++++++++----------------------- tests/texlive.scm | 3 - 5 files changed, 119 insertions(+), 146 deletions(-) diff --git a/guix/tests/http.scm b/guix/tests/http.scm index 4119e9ce01..4ee60e8864 100644 --- a/guix/tests/http.scm +++ b/guix/tests/http.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,10 +24,10 @@ #:use-module (web response) #:use-module (srfi srfi-39) #:use-module (ice-9 match) + #:use-module (ice-9 receive) #:export (with-http-server call-with-http-server %http-server-port - http-server-can-listen? %local-url)) ;;; Commentary: @@ -37,12 +38,13 @@ (define %http-server-port ;; TCP port to use for the stub HTTP server. - (make-parameter 9999)) + ;; If 0, the OS will automatically choose + ;; a port. + (make-parameter 0)) (define (open-http-server-socket) - "Return a listening socket for the web server. It is useful to export it so -that tests can check whether we succeeded opening the socket and tests skip if -needed." + "Return a listening socket for the web server and the port +actually listened at (in case %http-server-port was 0)." (catch 'system-error (lambda () (let ((sock (socket PF_INET SOCK_STREAM 0))) @@ -50,22 +52,18 @@ needed." (bind sock (make-socket-address AF_INET INADDR_LOOPBACK (%http-server-port))) - sock)) + (values sock + (sockaddr:port (getsockname sock))))) (lambda args (let ((err (system-error-errno args))) (format (current-error-port) "warning: cannot run Web server for tests: ~a~%" (strerror err)) - #f)))) - -(define (http-server-can-listen?) - "Return #t if we managed to open a listening socket." - (and=> (open-http-server-socket) - (lambda (socket) - (close-port socket) - #t))) + (values #f #f))))) (define* (%local-url #:optional (port (%http-server-port))) + (when (= port 0) + (error "no web server is running!")) ;; URL to use for 'home-page' tests. (string-append "http://localhost:" (number->string port) "/foo/bar")) @@ -73,7 +71,10 @@ needed." (define* (call-with-http-server responses+data thunk) "Call THUNK with an HTTP server running and returning RESPONSES+DATA on HTTP requests. Each element of RESPONSES+DATA must be a tuple containing a -response and a string, or an HTTP response code and a string." +response and a string, or an HTTP response code and a string. + +%http-server-port will be set to the port listened at +The port listened at will be set for the dynamic extent of THUNK." (define responses (map (match-lambda (((? response? response) data) @@ -100,6 +101,7 @@ response and a string, or an HTTP response code and a string." ;; Mutex and condition variable to synchronize with the HTTP server. (define %http-server-lock (make-mutex)) (define %http-server-ready (make-condition-variable)) + (define %http-real-server-port #f) (define (http-open . args) "Start listening for HTTP requests and signal %HTTP-SERVER-READY." @@ -122,7 +124,9 @@ response and a string, or an HTTP response code and a string." (set! responses rest) (values response data)))) - (let ((socket (open-http-server-socket))) + (receive (socket port) + (open-http-server-socket) + (set! %http-real-server-port port) (catch 'quit (lambda () (run-server handle stub-http-server @@ -134,7 +138,8 @@ response and a string, or an HTTP response code and a string." (let ((server (make-thread server-body))) (wait-condition-variable %http-server-ready %http-server-lock) ;; Normally SERVER exits automatically once it has received a request. - (thunk)))) + (parameterize ((%http-server-port %http-real-server-port)) + (thunk))))) (define-syntax with-http-server (syntax-rules () diff --git a/tests/derivations.scm b/tests/derivations.scm index 9f1104a887..cd165d1be6 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -77,9 +77,6 @@ (lambda (e1 e2) (string. - (let* ((text (random-text)) - (drv (derivation %store "world" - "builtin:download" '() - #:env-vars `(("url" - . ,(object->string (%local-url)))) - #:hash-algo 'sha256 - #:hash (gcrypt:sha256 (string->utf8 text))))) - (and (with-http-server `((200 ,text)) - (build-derivations %store (list drv))) - (with-http-server `((200 ,text)) - (build-derivations %store (list drv) - (build-mode check))) - (string=? (call-with-input-file (derivation->output-path drv) - get-string-all) - text)))) + (let* ((text (random-text))) + (with-http-server `((200 ,text)) + (let ((drv (derivation %store "world" + "builtin:download" '() + #:env-vars `(("url" + . ,(object->string (%local-url)))) + #:hash-algo 'sha256 + #:hash (gcrypt:sha256 (string->utf8 text))))) + (and drv (build-derivations %store (list drv)) + (with-http-server `((200 ,text)) + (build-derivations %store (list drv) + (build-mode check))) + (string=? (call-with-input-file (derivation->output-path drv) + get-string-all) + text)))))) (test-equal "derivation-name" "foo-0.0" diff --git a/tests/elpa.scm b/tests/elpa.scm index a008cf993c..01ef948b2e 100644 --- a/tests/elpa.scm +++ b/tests/elpa.scm @@ -40,9 +40,6 @@ nil "Integrated environment for *TeX*" tar ((:url . "http://www.gnu.org/software/auctex/"))]))) -;; Avoid collisions with other tests. -(%http-server-port 10300) - (test-begin "elpa") (define (eval-test-with-elpa pkg) diff --git a/tests/lint.scm b/tests/lint.scm index 7c24611934..b92053fd5f 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -62,7 +62,6 @@ ;; Test the linter. ;; Avoid collisions with other tests. -(%http-server-port 9999) (define %null-sha256 ;; SHA256 of the empty string. @@ -500,16 +499,16 @@ (home-page "http://does-not-exist")))) (warning-contains? "domain not found" (check-home-page pkg)))) -(test-skip (if (http-server-can-listen?) 0 1)) -(test-equal "home-page: Connection refused" - "URI http://localhost:9999/foo/bar unreachable: Connection refused" - (let ((pkg (package - (inherit (dummy-package "x")) - (home-page (%local-url))))) - (single-lint-warning-message - (check-home-page pkg)))) +(parameterize ((%http-server-port 9999)) + ;; TODO skip this test if some process is currently listening at 9999 + (test-equal "home-page: Connection refused" + "URI http://localhost:9999/foo/bar unreachable: Connection refused" + (let ((pkg (package + (inherit (dummy-package "x")) + (home-page (%local-url))))) + (single-lint-warning-message + (check-home-page pkg))))) -(test-skip (if (http-server-can-listen?) 0 1)) (test-equal "home-page: 200" '() (with-http-server `((200 ,%long-string)) @@ -518,10 +517,10 @@ (home-page (%local-url))))) (check-home-page pkg)))) -(test-skip (if (http-server-can-listen?) 0 1)) -(test-equal "home-page: 200 but short length" - "URI http://localhost:9999/foo/bar returned suspiciously small file (18 bytes)" - (with-http-server `((200 "This is too small.")) +(with-http-server `((200 "This is too small.")) + (test-equal "home-page: 200 but short length" + (format #f "URI ~a returned suspiciously small file (18 bytes)" + (%local-url)) (let ((pkg (package (inherit (dummy-package "x")) (home-page (%local-url))))) @@ -529,54 +528,51 @@ (single-lint-warning-message (check-home-page pkg))))) -(test-skip (if (http-server-can-listen?) 0 1)) -(test-equal "home-page: 404" - "URI http://localhost:9999/foo/bar not reachable: 404 (\"Such is life\")" - (with-http-server `((404 ,%long-string)) +(with-http-server `((404 ,%long-string)) + (test-equal "home-page: 404" + (format #f "URI ~a not reachable: 404 (\"Such is life\")" (%local-url)) (let ((pkg (package (inherit (dummy-package "x")) (home-page (%local-url))))) (single-lint-warning-message (check-home-page pkg))))) -(test-skip (if (http-server-can-listen?) 0 1)) -(test-equal "home-page: 301, invalid" - "invalid permanent redirect from http://localhost:9999/foo/bar" - (with-http-server `((301 ,%long-string)) +(with-http-server `((301 ,%long-string)) + (test-equal "home-page: 301, invalid" + (format #f "invalid permanent redirect from ~a" (%local-url)) (let ((pkg (package (inherit (dummy-package "x")) (home-page (%local-url))))) (single-lint-warning-message (check-home-page pkg))))) -(test-skip (if (http-server-can-listen?) 0 1)) -(test-equal "home-page: 301 -> 200" - "permanent redirect from http://localhost:10000/foo/bar to http://localhost:9999/foo/bar" - (with-http-server `((200 ,%long-string)) - (let* ((initial-url (%local-url)) - (redirect (build-response #:code 301 - #:headers - `((location - . ,(string->uri initial-url)))))) - (parameterize ((%http-server-port (+ 1 (%http-server-port)))) - (with-http-server `((,redirect "")) +(with-http-server `((200 ,%long-string)) + (let* ((initial-url (%local-url)) + (redirect (build-response #:code 301 + #:headers + `((location + . ,(string->uri initial-url)))))) + (parameterize ((%http-server-port 0)) + (with-http-server `((,redirect "")) + (test-equal "home-page: 301 -> 200" + (format #f "permanent redirect from ~a to ~a" + (%local-url) initial-url) (let ((pkg (package (inherit (dummy-package "x")) (home-page (%local-url))))) (single-lint-warning-message (check-home-page pkg)))))))) -(test-skip (if (http-server-can-listen?) 0 1)) -(test-equal "home-page: 301 -> 404" - "URI http://localhost:10000/foo/bar not reachable: 404 (\"Such is life\")" - (with-http-server '((404 "booh!")) - (let* ((initial-url (%local-url)) - (redirect (build-response #:code 301 - #:headers - `((location - . ,(string->uri initial-url)))))) - (parameterize ((%http-server-port (+ 1 (%http-server-port)))) - (with-http-server `((,redirect "")) +(with-http-server `((404 "booh!")) + (let* ((initial-url (%local-url)) + (redirect (build-response #:code 301 + #:headers + `((location + . ,(string->uri initial-url)))))) + (parameterize ((%http-server-port 0)) + (with-http-server `((,redirect "")) + (test-equal "home-page: 301 -> 404" + (format #f "URI ~a not reachable: 404 (\"Such is life\")" (%local-url)) (let ((pkg (package (inherit (dummy-package "x")) (home-page (%local-url))))) @@ -706,7 +702,6 @@ (sha256 %null-sha256)))))) (check-source-unstable-tarball pkg))) -(test-skip (if (http-server-can-listen?) 0 1)) (test-equal "source: 200" '() (with-http-server `((200 ,%long-string)) @@ -718,10 +713,10 @@ (sha256 %null-sha256)))))) (check-source pkg)))) -(test-skip (if (http-server-can-listen?) 0 1)) -(test-equal "source: 200 but short length" - "URI http://localhost:9999/foo/bar returned suspiciously small file (18 bytes)" - (with-http-server '((200 "This is too small.")) +(with-http-server '((200 "This is too small.")) + (test-equal "source: 200 but short length" + (format #f "URI ~a returned suspiciously small file (18 bytes)" + (%local-url)) (let ((pkg (package (inherit (dummy-package "x")) (source (origin @@ -733,10 +728,10 @@ (and (? lint-warning?) second-warning)) (lint-warning-message second-warning)))))) -(test-skip (if (http-server-can-listen?) 0 1)) -(test-equal "source: 404" - "URI http://localhost:9999/foo/bar not reachable: 404 (\"Such is life\")" - (with-http-server `((404 ,%long-string)) +(with-http-server `((404 ,%long-string)) + (test-equal "source: 404" + (format #f "URI ~a not reachable: 404 (\"Such is life\")" + (%local-url)) (let ((pkg (package (inherit (dummy-package "x")) (source (origin @@ -748,7 +743,6 @@ (and (? lint-warning?) second-warning)) (lint-warning-message second-warning)))))) -(test-skip (if (http-server-can-listen?) 0 1)) (test-equal "source: 404 and 200" '() (with-http-server `((404 ,%long-string)) @@ -765,17 +759,17 @@ ;; list. (check-source pkg))))))) -(test-skip (if (http-server-can-listen?) 0 1)) -(test-equal "source: 301 -> 200" - "permanent redirect from http://localhost:10000/foo/bar to http://localhost:9999/foo/bar" - (with-http-server `((200 ,%long-string)) - (let* ((initial-url (%local-url)) - (redirect (build-response #:code 301 - #:headers - `((location - . ,(string->uri initial-url)))))) - (parameterize ((%http-server-port (+ 1 (%http-server-port)))) - (with-http-server `((,redirect "")) +(with-http-server `((200 ,%long-string)) + (let* ((initial-url (%local-url)) + (redirect (build-response #:code 301 + #:headers + `((location + . ,(string->uri initial-url)))))) + (parameterize ((%http-server-port 0)) + (with-http-server `((,redirect "")) + (test-equal "source: 301 -> 200" + (format #f "permanent redirect from ~a to ~a" + (%local-url) initial-url) (let ((pkg (package (inherit (dummy-package "x")) (source (origin @@ -787,17 +781,17 @@ (and (? lint-warning?) second-warning)) (lint-warning-message second-warning))))))))) -(test-skip (if (http-server-can-listen?) 0 1)) -(test-equal "source, git-reference: 301 -> 200" - "permanent redirect from http://localhost:10000/foo/bar to http://localhost:9999/foo/bar" - (with-http-server `((200 ,%long-string)) - (let* ((initial-url (%local-url)) - (redirect (build-response #:code 301 - #:headers - `((location - . ,(string->uri initial-url)))))) - (parameterize ((%http-server-port (+ 1 (%http-server-port)))) - (with-http-server `((,redirect "")) +(with-http-server `((200 ,%long-string)) + (let* ((initial-url (%local-url)) + (redirect (build-response #:code 301 + #:headers + `((location + . ,(string->uri initial-url)))))) + (parameterize ((%http-server-port 0)) + (with-http-server `((,redirect "")) + (test-equal "source, git-reference: 301 -> 200" + (format #f "permanent redirect from ~a to ~a" + (%local-url) initial-url) (let ((pkg (dummy-package "x" (source (origin @@ -807,17 +801,17 @@ (sha256 %null-sha256)))))) (single-lint-warning-message (check-source pkg)))))))) -(test-skip (if (http-server-can-listen?) 0 1)) -(test-equal "source: 301 -> 404" - "URI http://localhost:10000/foo/bar not reachable: 404 (\"Such is life\")" - (with-http-server '((404 "booh!")) - (let* ((initial-url (%local-url)) - (redirect (build-response #:code 301 - #:headers - `((location - . ,(string->uri initial-url)))))) - (parameterize ((%http-server-port (+ 1 (%http-server-port)))) - (with-http-server `((,redirect "")) +(with-http-server '((404 "booh!")) + (let* ((initial-url (%local-url)) + (redirect (build-response #:code 301 + #:headers + `((location + . ,(string->uri initial-url)))))) + (parameterize ((%http-server-port 0)) + (with-http-server `((,redirect "")) + (test-equal "source: 301 -> 404" + (format #f "URI ~a not reachable: 404 (\"Such is life\")" + (%local-url)) (let ((pkg (package (inherit (dummy-package "x")) (source (origin @@ -847,7 +841,6 @@ (single-lint-warning-message (check-mirror-url (dummy-package "x" (source source)))))) -(test-skip (if (http-server-can-listen?) 0 1)) (test-equal "github-url" '() (with-http-server `((200 ,%long-string)) @@ -859,7 +852,6 @@ (sha256 %null-sha256))))))) (let ((github-url "https://github.com/foo/bar/bar-1.0.tar.gz")) - (test-skip (if (http-server-can-listen?) 0 1)) (test-equal "github-url: one suggestion" (string-append "URL should be '" github-url "'") @@ -873,7 +865,7 @@ #:headers `((location . ,(string->uri initial-url)))))) - (parameterize ((%http-server-port (+ 1 (%http-server-port)))) + (parameterize ((%http-server-port 0)) (with-http-server `((,redirect "")) (single-lint-warning-message (check-github-url @@ -883,7 +875,6 @@ (uri (%local-url)) (sha256 %null-sha256)))))))))))) - (test-skip (if (http-server-can-listen?) 0 1)) (test-equal "github-url: already the correct github url" '() (check-github-url @@ -1007,7 +998,6 @@ '() (check-formatting (dummy-package "x"))) -(test-skip (if (http-server-can-listen?) 0 1)) (test-assert "archival: missing content" (let* ((origin (origin (method url-fetch) @@ -1019,7 +1009,6 @@ (source origin))))))) (warning-contains? "not archived" warnings))) -(test-skip (if (http-server-can-listen?) 0 1)) (test-equal "archival: content available" '() (let* ((origin (origin @@ -1033,7 +1022,6 @@ (parameterize ((%swh-base-url (%local-url))) (check-archival (dummy-package "x" (source origin))))))) -(test-skip (if (http-server-can-listen?) 0 1)) (test-assert "archival: missing revision" (let* ((origin (origin (method git-fetch) @@ -1053,7 +1041,6 @@ (check-archival (dummy-package "x" (source origin))))))) (warning-contains? "scheduled" warnings))) -(test-skip (if (http-server-can-listen?) 0 1)) (test-equal "archival: revision available" '() (let* ((origin (origin @@ -1069,7 +1056,6 @@ (parameterize ((%swh-base-url (%local-url))) (check-archival (dummy-package "x" (source origin))))))) -(test-skip (if (http-server-can-listen?) 0 1)) (test-assert "archival: rate limit reached" ;; We should get a single warning stating that the rate limit was reached, ;; and nothing more, in particular no other HTTP requests. @@ -1091,7 +1077,6 @@ (string-contains (single-lint-warning-message warnings) "rate limit reached"))) -(test-skip (if (http-server-can-listen?) 0 1)) (test-assert "haskell-stackage" (let* ((stackage (string-append "{ \"packages\": [{" " \"name\":\"x\"," diff --git a/tests/texlive.scm b/tests/texlive.scm index f7e5515c4c..a6f08046a8 100644 --- a/tests/texlive.scm +++ b/tests/texlive.scm @@ -69,9 +69,6 @@ (keyval (@ (value "tests") (key "topic"))) "\n null\n"))) -;; Avoid collisions with other tests. -(%http-server-port 10200) - (test-equal "fetch-sxml: returns SXML for valid XML" sxml (with-http-server `((200 ,xml)) -- 2.30.0