Package: guix-patches;
Reported by: Maxime Devos <maximedevos <at> telenet.be>
Date: Sat, 20 Feb 2021 22:02:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
Message #8 received at 46668 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Maxime Devos <maximedevos <at> telenet.be> Cc: 46668 <at> debbugs.gnu.org Subject: Re: bug#46668: [PATCH]: tests: do not hard code HTTP ports Date: Mon, 01 Mar 2021 16:46:30 +0100
Hi Maxime,
Maxime Devos <maximedevos <at> telenet.be> skribis:
> From 6a5ea1f1a9155e23e46a38577adf74527ba50b2c Mon Sep 17 00:00:00 2001
> From: Maxime Devos <maximedevos <at> telenet.be>
> 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.
Nice!
Some comments below.
> + #:use-module (ice-9 receive)
Please use (srfi srfi-71) instead, or (srfi srfi-11).
> -(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
> ;; works. See <http://bugs.gnu.org/25089>.
> - (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))))))
This hunk shouldn’t be here.
> -(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)))))
Likewise.
> -(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))
Likewise.
> -(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))
Likewise.
> -(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))
Likewise.
> -(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))))))
Likewise.
> -(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!"))
Likewise.
> -(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))
Likewise.
> -(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))
Likewise.
> -(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))
Likewise.
> -(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))
Likewise.
> -(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!"))
Likewise.
Could you send an updated patch?
Thanks!
Ludo’.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.