[bug#46668] [PATCH]: tests: do not hard code HTTP ports

["Ludovic Courtès" <ludo@gnu.org>]

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

> From 6a5ea1f1a9155e23e46a38577adf74527ba50b2c Mon Sep 17 00:00:00 2001
> From: Maxime Devos <maximedevos@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’.