From 18e2cfa112c3393b4191bb3497bf9a0ae643c2a2 Mon Sep 17 00:00:00 2001
From: dickmao <dick.r.chiang@gmail.com>
Date: Mon, 29 Nov 2021 20:31:28 -0500
Subject: [PATCH] Don't repeat yourself (DRY)

* test/lisp/net/network-stream-tests.el
(network-test--resolve-system-name): DRY.
(network-stream-tests--resolve-system-name): DRY.
(network-stream-tests-echo-server): DRY.
(echo-server-with-dns): DRY.
(echo-server-with-localhost): DRY.
(echo-server-with-local-ipv4): DRY.
(echo-server-with-local-ipv6): DRY.
(echo-server-with-ip): DRY.
(echo-server-nowait): DRY.
(make-tls-server): DRY.
(network-stream-tests-make-network-process): DRY.
(network-stream-tests-open-stream): DRY.
(network-stream-tests-doit): DRY.
(connect-to-tls-ipv4-wait): DRY.
(connect-to-tls-ipv4-nowait): DRY.
(connect-to-tls-ipv6-nowait): DRY.
(open-network-stream-tls-wait): DRY.
(open-network-stream-tls-nowait): DRY.
(open-network-stream-tls): DRY.
(open-network-stream-tls-nocert): DRY.
(open-gnutls-stream-new-api-default): DRY.
(open-gnutls-stream-new-api-wait): DRY.
(open-gnutls-stream-old-api-wait): DRY.
(open-gnutls-stream-new-api-nowait): DRY.
(open-gnutls-stream-old-api-nowait): DRY.
(open-gnutls-stream-new-api-errors): DRY.
---
 test/lisp/net/network-stream-tests.el | 730 ++++++++------------------
 1 file changed, 206 insertions(+), 524 deletions(-)

diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el
index 8f5bddb71f..fbb0d4af9b 100644
--- a/test/lisp/net/network-stream-tests.el
+++ b/test/lisp/net/network-stream-tests.el
@@ -138,7 +138,7 @@ server-process-filter
      (t
       ))))
 
-(defun network-test--resolve-system-name ()
+(defun network-stream-tests--resolve-system-name ()
   (cl-loop for address in (network-lookup-address-info (system-name))
            when (or (and (= (length address) 5)
                          ;; IPv4 localhost addresses start with 127.
@@ -148,594 +148,276 @@ network-test--resolve-system-name
                          (equal address [0 0 0 0 0 0 0 1 0])))
            return t))
 
+(defmacro network-stream-tests-retry (&rest body)
+  `(cl-loop with status
+            repeat 30
+            when (setq status (condition-case err
+                                  (progn ,@body)
+                                (error (prog1 nil
+                                         (message "retry: %s"
+                                                  (error-message-string err))))))
+            return status
+            do (accept-process-output nil 0.3)))
+
+(defmacro network-stream-tests-echo-server (make-server iport &rest params)
+  `(let* ((server ,make-server)
+          (port (aref (process-contact server :local) ,iport))
+          (buffer (generate-new-buffer "*foo*"))
+          (proc (make-network-process :name "foo"
+                                      :buffer buffer
+                                      :service port
+                                      ,@params)))
+     (network-stream-tests-retry (not (eq (process-status proc) 'connect)))
+     (unwind-protect
+         (with-current-buffer (process-buffer proc)
+           (process-send-string proc "echo foo")
+           (network-stream-tests-retry (equal (buffer-string) "foo\n")))
+       (when (process-live-p proc) (delete-process proc))
+       (let (kill-buffer-query-functions)
+         (kill-buffer buffer))
+       (when (process-live-p server) (delete-process server)))))
+
 (ert-deftest echo-server-with-dns ()
-  (unless (network-test--resolve-system-name)
-    (ert-skip "Can't test resolver for (system-name)"))
-
-  (let* ((server (make-server (system-name)))
-         (port (aref (process-contact server :local) 4))
-         (proc (make-network-process :name "foo"
-                                     :buffer (generate-new-buffer "*foo*")
-                                     :host (system-name)
-                                     :service port)))
-    (with-current-buffer (process-buffer proc)
-      (process-send-string proc "echo foo")
-      (sleep-for 0.1)
-      (should (equal (buffer-string) "foo\n")))
-    (delete-process server)))
+  (skip-unless (network-stream-tests--resolve-system-name))
+  (network-stream-tests-echo-server
+   (make-server (system-name)) 4
+   :host (system-name)))
 
 (ert-deftest echo-server-with-localhost ()
-  (let* ((server (make-server 'local))
-         (port (aref (process-contact server :local) 4))
-         (proc (make-network-process :name "foo"
-                                     :buffer (generate-new-buffer "*foo*")
-                                     :host "localhost"
-                                     :service port)))
-    (with-current-buffer (process-buffer proc)
-      (process-send-string proc "echo foo")
-      (sleep-for 0.1)
-      (should (equal (buffer-string) "foo\n")))
-    (delete-process server)))
+  (network-stream-tests-echo-server
+   (make-server 'local) 4
+   :host "localhost"))
+
 
 (ert-deftest echo-server-with-local-ipv4 ()
-  (let* ((server (make-server 'local 'ipv4))
-         (port (aref (process-contact server :local) 4))
-         (proc (make-network-process :name "foo"
-                                     :buffer (generate-new-buffer "*foo*")
-                                     :host 'local
-                                     :family 'ipv4
-                                     :service port)))
-    (with-current-buffer (process-buffer proc)
-      (process-send-string proc "echo foo")
-      (sleep-for 0.1)
-      (should (equal (buffer-string) "foo\n")))
-    (delete-process server)))
+  (network-stream-tests-echo-server
+   (make-server 'local 'ipv4) 4
+   :host 'local
+   :family 'ipv4))
 
 (ert-deftest echo-server-with-local-ipv6 ()
   (skip-unless (featurep 'make-network-process '(:family ipv6)))
-  (let ((server (ignore-errors (make-server 'local 'ipv6))))
-    (skip-unless server)
-    (let* ((port (aref (process-contact server :local) 8))
-           (proc (make-network-process :name "foo"
-                                       :buffer (generate-new-buffer "*foo*")
-                                       :host 'local
-                                       :family 'ipv6
-                                       :service port)))
-      (with-current-buffer (process-buffer proc)
-        (process-send-string proc "echo foo")
-        (sleep-for 0.1)
-        (should (equal (buffer-string) "foo\n")))
-      (delete-process server))))
+  (network-stream-tests-echo-server
+   (make-server 'local 'ipv6) 8
+   :host 'local
+   :family 'ipv6))
 
 (ert-deftest echo-server-with-ip ()
-  (let* ((server (make-server 'local))
-         (port (aref (process-contact server :local) 4))
-         (proc (make-network-process :name "foo"
-                                     :buffer (generate-new-buffer "*foo*")
-                                     :host "127.0.0.1"
-                                     :service port)))
-    (with-current-buffer (process-buffer proc)
-      (process-send-string proc "echo foo")
-      (sleep-for 0.1)
-      (should (equal (buffer-string) "foo\n")))
-    (delete-process server)))
+  (network-stream-tests-echo-server
+   (make-server 'local) 4
+   :host "127.0.0.1"))
 
 (ert-deftest echo-server-nowait ()
-  (let* ((server (make-server 'local))
-         (port (aref (process-contact server :local) 4))
-         (proc (make-network-process :name "foo"
-                                     :buffer (generate-new-buffer "*foo*")
-                                     :host "localhost"
-                                     :nowait t
-                                     :family 'ipv4
-                                     :service port))
-         (times 0))
-    (should (eq (process-status proc) 'connect))
-    (while (and (eq (process-status proc) 'connect)
-                (< (setq times (1+ times)) 10))
-      (sit-for 0.1))
-    (skip-unless (not (eq (process-status proc) 'connect)))
-    (with-current-buffer (process-buffer proc)
-      (process-send-string proc "echo foo")
-      (sleep-for 0.1)
-      (should (equal (buffer-string) "foo\n")))
-    (delete-process server)))
-
-(defun make-tls-server (port)
-  (start-process "gnutls" (generate-new-buffer "*tls*")
-                 "gnutls-serv" "--http"
-                 "--x509keyfile"
-                 (ert-resource-file "key.pem")
-                 "--x509certfile"
-                 (ert-resource-file "cert.pem")
-                 "--port" (format "%s" port)))
+  (network-stream-tests-echo-server
+   (make-server 'local) 4
+   :host "localhost"
+   :nowait t
+   :family 'ipv4))
+
+(defun make-tls-server ()
+  (let ((free-port (with-temp-buffer
+                     (let ((proc (make-network-process
+                                  :name "free-port"
+                                  :noquery t
+                                  :host "127.0.0.1"
+                                  :buffer (current-buffer)
+                                  :server t
+                                  :stop t
+                                  :service t)))
+                       (prog1 (process-contact proc :service)
+                         (delete-process proc))))))
+    (cons free-port
+          (start-process "gnutls" (generate-new-buffer "*tls*")
+                         "gnutls-serv" "--http"
+                         "--x509keyfile"
+                         (ert-resource-file "key.pem")
+                         "--x509certfile"
+                         (ert-resource-file "cert.pem")
+                         "--port" (format "%s" free-port)))))
+
+(defmacro network-stream-tests-make-network-process (negotiate &rest params)
+  `(pcase-let ((`(,port . ,server) (make-tls-server))
+               (buffer (generate-new-buffer "*foo*")))
+     (unwind-protect
+         (network-stream-tests-doit
+          port server
+          (make-network-process
+           :name "bar"
+           :buffer buffer
+           :service port
+           ,@params)
+          ,negotiate)
+       (let (kill-buffer-query-functions)
+         (kill-buffer buffer))
+       (when (process-live-p server) (delete-process server)))))
+
+(defmacro network-stream-tests-open-stream (func &rest params)
+  `(pcase-let ((`(,port . ,server) (make-tls-server))
+               (buffer (generate-new-buffer "*foo*")))
+     (unwind-protect
+         (network-stream-tests-doit
+          port server
+          (,func
+           "bar"
+           buffer
+           "localhost"
+           port
+           ,@params))
+       (let (kill-buffer-query-functions)
+         (kill-buffer buffer))
+       (when (process-live-p server) (delete-process server)))))
+
+(cl-defmacro network-stream-tests-doit (port server form &optional negotiate)
+  `(let ((network-security-level 'low)
+         proc status)
+     (unwind-protect
+         (progn
+           (with-current-buffer (process-buffer ,server)
+             (message "gnutls-serv on %s: %s" ,port (buffer-string)))
+           (should (setq proc (network-stream-tests-retry ,form)))
+           (,(if negotiate 'funcall 'ignore)
+            #'gnutls-negotiate :process proc
+            :type 'gnutls-x509pki
+            :hostname "localhost")
+           (network-stream-tests-retry (not (eq (process-status proc) 'connect)))
+           (should (consp (setq status (network-stream-tests-retry
+                                        (gnutls-peer-status proc)))))
+           (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
+             (should (stringp issuer))
+             (setq issuer (split-string issuer ","))
+             (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))
+       (when (process-live-p proc) (delete-process proc)))))
 
 (ert-deftest connect-to-tls-ipv4-wait ()
+  :expected-result (if (getenv "CI") t :passed)
   (skip-unless (executable-find "gnutls-serv"))
   (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44332))
-        (times 0)
-        proc status)
-    (unwind-protect
-        (progn
-          (sleep-for 1)
-          (with-current-buffer (process-buffer server)
-            (message "gnutls-serv: %s" (buffer-string)))
-
-          ;; It takes a while for gnutls-serv to start.
-          (while (and (null (ignore-errors
-                              (setq proc (make-network-process
-                                          :name "bar"
-                                          :buffer (generate-new-buffer "*foo*")
-                                          :host "localhost"
-                                          :service 44332))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (should proc)
-          (gnutls-negotiate :process proc
-                            :type 'gnutls-x509pki
-                            :hostname "localhost"))
-      (if (process-live-p server) (delete-process server)))
-    (setq status (gnutls-peer-status proc))
-    (should (consp status))
-    (delete-process proc)
-    ;; This sleep-for is needed for the native MS-Windows build.  If
-    ;; it is removed, the next test mysteriously fails because the
-    ;; initial part of the echo is not received.
-    (sleep-for 0.1)
-    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
-      (should (stringp issuer))
-      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
+  (network-stream-tests-make-network-process
+   t
+   :host "localhost"))
 
 (ert-deftest connect-to-tls-ipv4-nowait ()
+  :expected-result (if (getenv "CI") t :passed)
   (skip-unless (executable-find "gnutls-serv"))
   (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44331))
-        (times 0)
-        (network-security-level 'low)
-        proc status)
-    (unwind-protect
-        (progn
-          (sleep-for 1)
-          (with-current-buffer (process-buffer server)
-            (message "gnutls-serv: %s" (buffer-string)))
-
-          ;; It takes a while for gnutls-serv to start.
-          (while (and (null (ignore-errors
-                              (setq proc (make-network-process
-                                          :name "bar"
-                                          :buffer (generate-new-buffer "*foo*")
-                                          :nowait t
-                                          :family 'ipv4
-                                          :tls-parameters
-                                          (cons 'gnutls-x509pki
-                                                (gnutls-boot-parameters
-                                                 :hostname "localhost"))
-                                          :host "localhost"
-                                          :service 44331))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (should proc)
-          (setq times 0)
-          (while (and (eq (process-status proc) 'connect)
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (skip-unless (not (eq (process-status proc) 'connect))))
-      (if (process-live-p server) (delete-process server)))
-    (setq status (gnutls-peer-status proc))
-    (should (consp status))
-    (delete-process proc)
-    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
-      (should (stringp issuer))
-      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
+  (network-stream-tests-make-network-process
+   nil
+   :nowait t
+   :family 'ipv4
+   :tls-parameters
+   (cons 'gnutls-x509pki
+         (gnutls-boot-parameters
+          :hostname "localhost"))
+   :host "localhost"))
 
 (ert-deftest connect-to-tls-ipv6-nowait ()
+  :expected-result (if (getenv "CI") t :passed)
   (skip-unless (executable-find "gnutls-serv"))
   (skip-unless (gnutls-available-p))
   (skip-unless (not (eq system-type 'windows-nt)))
   (skip-unless (featurep 'make-network-process '(:family ipv6)))
-  (let ((server (make-tls-server 44333))
-        (times 0)
-        (network-security-level 'low)
-        proc status)
-    (unwind-protect
-        (progn
-          (sleep-for 1)
-          (with-current-buffer (process-buffer server)
-            (message "gnutls-serv: %s" (buffer-string)))
-
-          ;; It takes a while for gnutls-serv to start.
-          (while (and (null (ignore-errors
-                              (setq proc (make-network-process
-                                          :name "bar"
-                                          :buffer (generate-new-buffer "*foo*")
-                                          :family 'ipv6
-                                          :nowait t
-                                          :tls-parameters
-                                          (cons 'gnutls-x509pki
-                                                (gnutls-boot-parameters
-                                                 :hostname "localhost"))
-                                          :host "::1"
-                                          :service 44333))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (should proc)
-          (setq times 0)
-          (while (and (eq (process-status proc) 'connect)
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (skip-unless (not (eq (process-status proc) 'connect))))
-      (if (process-live-p server) (delete-process server)))
-    (setq status (gnutls-peer-status proc))
-    (should (consp status))
-    (delete-process proc)
-    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
-      (should (stringp issuer))
-      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
+  (network-stream-tests-make-network-process
+   nil
+   :family 'ipv6
+   :nowait t
+   :tls-parameters
+   (cons 'gnutls-x509pki
+         (gnutls-boot-parameters
+          :hostname "localhost"))
+   :host "::1"))
 
 (ert-deftest open-network-stream-tls-wait ()
+  :expected-result (if (getenv "CI") t :passed)
   (skip-unless (executable-find "gnutls-serv"))
   (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44334))
-        (times 0)
-        (network-security-level 'low)
-        proc status)
-    (unwind-protect
-        (progn
-          (sleep-for 1)
-          (with-current-buffer (process-buffer server)
-            (message "gnutls-serv: %s" (buffer-string)))
-
-          ;; It takes a while for gnutls-serv to start.
-          (while (and (null (ignore-errors
-                              (setq proc (open-network-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44334
-                                          :type 'tls
-                                          :nowait nil))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (should proc)
-          (skip-unless (not (eq (process-status proc) 'connect))))
-      (if (process-live-p server) (delete-process server)))
-    (setq status (gnutls-peer-status proc))
-    (should (consp status))
-    (delete-process proc)
-    ;; This sleep-for is needed for the native MS-Windows build.  If
-    ;; it is removed, the next test mysteriously fails because the
-    ;; initial part of the echo is not received.
-    (sleep-for 0.1)
-    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
-      (should (stringp issuer))
-      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
+  (network-stream-tests-open-stream
+   open-network-stream
+   :type 'tls
+   :nowait nil))
 
 (ert-deftest open-network-stream-tls-nowait ()
+  :expected-result (if (getenv "CI") t :passed)
   (skip-unless (executable-find "gnutls-serv"))
   (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44335))
-        (times 0)
-        (network-security-level 'low)
-        proc status)
-    (unwind-protect
-        (progn
-          (sleep-for 1)
-          (with-current-buffer (process-buffer server)
-            (message "gnutls-serv: %s" (buffer-string)))
-
-          ;; It takes a while for gnutls-serv to start.
-          (while (and (null (ignore-errors
-                              (setq proc (open-network-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44335
-                                          :type 'tls
-                                          :nowait t))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (should proc)
-          (setq times 0)
-          (while (and (eq (process-status proc) 'connect)
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (skip-unless (not (eq (process-status proc) 'connect))))
-      (if (process-live-p server) (delete-process server)))
-    (setq status (gnutls-peer-status proc))
-    (should (consp status))
-    (delete-process proc)
-    ;; This sleep-for is needed for the native MS-Windows build.  If
-    ;; it is removed, the next test mysteriously fails because the
-    ;; initial part of the echo is not received.
-    (sleep-for 0.1)
-    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
-      (should (stringp issuer))
-      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
+  (network-stream-tests-open-stream
+   open-network-stream
+   :type 'tls
+   :nowait t))
 
 (ert-deftest open-network-stream-tls ()
+  :expected-result (if (getenv "CI") t :passed)
   (skip-unless (executable-find "gnutls-serv"))
   (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44336))
-        (times 0)
-        (network-security-level 'low)
-        proc status)
-    (unwind-protect
-        (progn
-          (sleep-for 1)
-          (with-current-buffer (process-buffer server)
-            (message "gnutls-serv: %s" (buffer-string)))
-
-          ;; It takes a while for gnutls-serv to start.
-          (while (and (null (ignore-errors
-                              (setq proc (open-network-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44336
-                                          :type 'tls))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (should proc)
-          (skip-unless (not (eq (process-status proc) 'connect))))
-      (if (process-live-p server) (delete-process server)))
-    (setq status (gnutls-peer-status proc))
-    (should (consp status))
-    (delete-process proc)
-    ;; This sleep-for is needed for the native MS-Windows build.  If
-    ;; it is removed, the next test mysteriously fails because the
-    ;; initial part of the echo is not received.
-    (sleep-for 0.1)
-    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
-      (should (stringp issuer))
-      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
+  (network-stream-tests-open-stream
+   open-network-stream
+   :type 'tls))
 
 (ert-deftest open-network-stream-tls-nocert ()
+  :expected-result (if (getenv "CI") t :passed)
   (skip-unless (executable-find "gnutls-serv"))
   (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44337))
-        (times 0)
-        (network-security-level 'low)
-        proc status)
-    (unwind-protect
-        (progn
-          (sleep-for 1)
-          (with-current-buffer (process-buffer server)
-            (message "gnutls-serv: %s" (buffer-string)))
-
-          ;; It takes a while for gnutls-serv to start.
-          (while (and (null (ignore-errors
-                              (setq proc (open-network-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44337
-                                          :type 'tls
-                                          :client-certificate nil))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (should proc)
-          (skip-unless (not (eq (process-status proc) 'connect))))
-      (if (process-live-p server) (delete-process server)))
-    (setq status (gnutls-peer-status proc))
-    (should (consp status))
-    (delete-process proc)
-    ;; This sleep-for is needed for the native MS-Windows build.  If
-    ;; it is removed, the next test mysteriously fails because the
-    ;; initial part of the echo is not received.
-    (sleep-for 0.1)
-    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
-      (should (stringp issuer))
-      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
+  (network-stream-tests-open-stream
+   open-network-stream
+   :type 'tls
+   :client-certificate nil))
 
 (ert-deftest open-gnutls-stream-new-api-default ()
+  :expected-result (if (getenv "CI") t :passed)
   (skip-unless (executable-find "gnutls-serv"))
   (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44665))
-        (times 0)
-        proc status)
-    (unwind-protect
-        (progn
-          (sleep-for 1)
-          (with-current-buffer (process-buffer server)
-            (message "gnutls-serv: %s" (buffer-string)))
-
-          ;; It takes a while for gnutls-serv to start.
-          (while (and (null (ignore-errors
-                              (setq proc (open-gnutls-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44665))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (should proc)
-      (if (process-live-p server) (delete-process server)))
-    (setq status (gnutls-peer-status proc))
-    (should (consp status))
-    (delete-process proc)
-    ;; This sleep-for is needed for the native MS-Windows build.  If
-    ;; it is removed, the next test mysteriously fails because the
-    ;; initial part of the echo is not received.
-    (sleep-for 0.1)
-    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
-      (should (stringp issuer))
-      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))))
+  (network-stream-tests-open-stream
+   open-gnutls-stream))
 
 (ert-deftest open-gnutls-stream-new-api-wait ()
+  :expected-result (if (getenv "CI") t :passed)
   (skip-unless (executable-find "gnutls-serv"))
   (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44666))
-        (times 0)
-        proc status)
-    (unwind-protect
-        (progn
-          (sleep-for 1)
-          (with-current-buffer (process-buffer server)
-            (message "gnutls-serv: %s" (buffer-string)))
-
-          ;; It takes a while for gnutls-serv to start.
-          (while (and (null (ignore-errors
-                              (setq proc (open-gnutls-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44666
-                                          (list :nowait nil)))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (should proc)
-      (if (process-live-p server) (delete-process server)))
-    (setq status (gnutls-peer-status proc))
-    (should (consp status))
-    (delete-process proc)
-    ;; This sleep-for is needed for the native MS-Windows build.  If
-    ;; it is removed, the next test mysteriously fails because the
-    ;; initial part of the echo is not received.
-    (sleep-for 0.1)
-    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
-      (should (stringp issuer))
-      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))))
+  (network-stream-tests-open-stream
+   open-gnutls-stream
+   (list :nowait nil)))
 
 (ert-deftest open-gnutls-stream-old-api-wait ()
+  :expected-result (if (getenv "CI") t :passed)
   (skip-unless (executable-find "gnutls-serv"))
   (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44667))
-        (times 0)
-        (nowait nil) ; Workaround Bug#47080
-        proc status)
-    (unwind-protect
-        (progn
-          (sleep-for 1)
-          (with-current-buffer (process-buffer server)
-            (message "gnutls-serv: %s" (buffer-string)))
-
-          ;; It takes a while for gnutls-serv to start.
-          (while (and (null (ignore-errors
-                              (setq proc (open-gnutls-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44667
-                                          nowait))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (should proc)
-      (if (process-live-p server) (delete-process server)))
-    (setq status (gnutls-peer-status proc))
-    (should (consp status))
-    (delete-process proc)
-    ;; This sleep-for is needed for the native MS-Windows build.  If
-    ;; it is removed, the next test mysteriously fails because the
-    ;; initial part of the echo is not received.
-    (sleep-for 0.1)
-    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
-      (should (stringp issuer))
-      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))))
+  (network-stream-tests-open-stream
+   open-gnutls-stream
+   nil))
 
 (ert-deftest open-gnutls-stream-new-api-nowait ()
+  :expected-result (if (getenv "CI") t :passed)
   (skip-unless (executable-find "gnutls-serv"))
   (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44668))
-        (times 0)
-        (network-security-level 'low)
-        proc status)
-    (unwind-protect
-        (progn
-          (sleep-for 1)
-          (with-current-buffer (process-buffer server)
-            (message "gnutls-serv: %s" (buffer-string)))
-
-          ;; It takes a while for gnutls-serv to start.
-          (while (and (null (ignore-errors
-                              (setq proc (open-gnutls-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44668
-                                          (list :nowait t)))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (should proc)
-          (setq times 0)
-          (while (and (eq (process-status proc) 'connect)
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (skip-unless (not (eq (process-status proc) 'connect))))
-      (if (process-live-p server) (delete-process server)))
-    (setq status (gnutls-peer-status proc))
-    (should (consp status))
-    (delete-process proc)
-    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
-      (should (stringp issuer))
-      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
+  (network-stream-tests-open-stream
+   open-gnutls-stream
+   (list :nowait t)))
 
 (ert-deftest open-gnutls-stream-old-api-nowait ()
+  :expected-result (if (getenv "CI") t :passed)
   (skip-unless (executable-find "gnutls-serv"))
   (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44669))
-        (times 0)
-        (network-security-level 'low)
-        (nowait t)
-        proc status)
-    (unwind-protect
-        (progn
-          (sleep-for 1)
-          (with-current-buffer (process-buffer server)
-            (message "gnutls-serv: %s" (buffer-string)))
-
-          ;; It takes a while for gnutls-serv to start.
-          (while (and (null (ignore-errors
-                              (setq proc (open-gnutls-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44669
-                                          nowait))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (should proc)
-          (setq times 0)
-          (while (and (eq (process-status proc) 'connect)
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (skip-unless (not (eq (process-status proc) 'connect))))
-      (if (process-live-p server) (delete-process server)))
-    (setq status (gnutls-peer-status proc))
-    (should (consp status))
-    (delete-process proc)
-    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
-      (should (stringp issuer))
-      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
+  (network-stream-tests-open-stream
+   open-gnutls-stream
+   t))
 
 (ert-deftest open-gnutls-stream-new-api-errors ()
   (skip-unless (gnutls-available-p))
-  (should-error
-   (open-gnutls-stream
-    "bar"
-    (generate-new-buffer "*foo*")
-    "localhost"
-    44777
-    (list t)))
-  (should-error
-   (open-gnutls-stream
-    "bar"
-    (generate-new-buffer "*foo*")
-    "localhost"
-    44777
-    (vector :nowait t))))
+  (pcase-let ((`(,port . ,server) (make-tls-server)))
+    (kill-process server)
+    (should-error
+     (open-gnutls-stream
+      "bar"
+      (generate-new-buffer "*foo*")
+      "localhost"
+      port
+      (list t)))
+    (should-error
+     (open-gnutls-stream
+      "bar"
+      (generate-new-buffer "*foo*")
+      "localhost"
+      port
+      (vector :nowait t)))))
 
 (ert-deftest check-network-process-coding-system-bind ()
   "Check that binding coding-system-for-{read,write} works."
-- 
2.26.2