From b0942a815f5845e3dbf685e71f4314d1ebfbf44f Mon Sep 17 00:00:00 2001 From: ikappaki Date: Mon, 19 Dec 2022 12:38:04 +0000 Subject: [PATCH] Use improved test poller for siblings test while increasing timeout The `nrepl-tests-poll-until` poller is a copy from the one found in integration utils and replaces `nrepl-tests-sleep-until`. --- test/cider-tests.el | 91 ++++++++++++++++++--------------- test/nrepl-client-tests.el | 11 ++-- test/utils/nrepl-tests-utils.el | 25 ++++----- 3 files changed, 67 insertions(+), 60 deletions(-) diff --git a/test/cider-tests.el b/test/cider-tests.el index ecb6cabbc..2705bef02 100644 --- a/test/cider-tests.el +++ b/test/cider-tests.el @@ -591,58 +591,67 @@ (describe "sets nrepl client local vars correctly" (it "for nbb project" (let* ((server-process (nrepl-start-mock-server-process)) - (server-buffer (process-buffer server-process)) - (client-buffer (cider-connect-sibling-cljs - '(:cljs-repl-type nbb) server-buffer))) - ;; native cljs REPL - (expect (buffer-local-value 'cider-repl-type client-buffer) - :to-equal 'cljs) - (expect (buffer-local-value 'cider-repl-cljs-upgrade-pending client-buffer) - :to-equal nil) - (expect (buffer-local-value 'cider-repl-init-function client-buffer) - :to-be nil) - (delete-process (get-buffer-process client-buffer)))) + (server-buffer (process-buffer server-process))) + ;; wait for the connection to be established + (nrepl-tests-poll-until (local-variable-p 'nrepl-endpoint server-buffer) 5) + (let ((client-buffer (cider-connect-sibling-cljs + '(:cljs-repl-type nbb) server-buffer))) + + ;; native cljs REPL + (expect (buffer-local-value 'cider-repl-type client-buffer) + :to-equal 'cljs) + (expect (buffer-local-value 'cider-repl-cljs-upgrade-pending client-buffer) + :to-equal nil) + (expect (buffer-local-value 'cider-repl-init-function client-buffer) + :to-be nil) + (delete-process (get-buffer-process client-buffer))))) (it "for shadow project" (let* ((cider-shadow-default-options "a-shadow-alias") (server-process (nrepl-start-mock-server-process)) - (server-buffer (process-buffer server-process)) - (client-buffer (cider-connect-sibling-cljs - '(:cljs-repl-type shadow) server-buffer))) + (server-buffer (process-buffer server-process))) + ;; wait for the connection to be established + (nrepl-tests-poll-until (local-variable-p 'nrepl-endpoint server-buffer) 5) ;; starts as clj REPL and requires a form to switch over to cljs - (expect (buffer-local-value 'cider-repl-type client-buffer) - :to-equal 'cljs) - (expect (buffer-local-value 'cider-repl-cljs-upgrade-pending client-buffer) - :to-equal t) - (expect (buffer-local-value 'cider-repl-init-function client-buffer) - :not :to-be nil) - (delete-process (get-buffer-process client-buffer)))) + (let ((client-buffer (cider-connect-sibling-cljs + '(:cljs-repl-type shadow) server-buffer))) + (expect (buffer-local-value 'cider-repl-type client-buffer) + :to-equal 'cljs) + (expect (buffer-local-value 'cider-repl-cljs-upgrade-pending client-buffer) + :to-equal t) + (expect (buffer-local-value 'cider-repl-init-function client-buffer) + :not :to-be nil) + (delete-process (get-buffer-process client-buffer))))) (it "for a custom cljs REPL type project" (cider-register-cljs-repl-type 'native-cljs) (let* ((server-process (nrepl-start-mock-server-process)) - (server-buffer (process-buffer server-process)) - (client-buffer (cider-connect-sibling-cljs - '(:cljs-repl-type native-cljs) - server-buffer))) - (expect (buffer-local-value 'cider-repl-type client-buffer) - :to-equal 'cljs) - (expect (buffer-local-value 'cider-repl-cljs-upgrade-pending client-buffer) - :to-equal nil) - (delete-process (get-buffer-process client-buffer)))) + (server-buffer (process-buffer server-process))) + ;; wait for the connection to be established + (nrepl-tests-poll-until (local-variable-p 'nrepl-endpoint server-buffer) 5) + (let ((client-buffer (cider-connect-sibling-cljs + '(:cljs-repl-type native-cljs) + server-buffer))) + (expect (buffer-local-value 'cider-repl-type client-buffer) + :to-equal 'cljs) + (expect (buffer-local-value 'cider-repl-cljs-upgrade-pending client-buffer) + :to-equal nil) + (delete-process (get-buffer-process client-buffer))))) (it "for a custom REPL type project that needs to switch to cljs" (cider-register-cljs-repl-type 'not-cljs-initially "(form-to-switch-to-cljs-repl)") (let* ((server-process (nrepl-start-mock-server-process)) - (server-buffer (process-buffer server-process)) - (client-buffer (cider-connect-sibling-cljs - '(:cljs-repl-type not-cljs-initially) - server-buffer))) - (expect (buffer-local-value 'cider-repl-type client-buffer) - :to-equal 'cljs) - (expect (buffer-local-value 'cider-repl-cljs-upgrade-pending client-buffer) - :to-equal t) - (expect (buffer-local-value 'cider-repl-init-function client-buffer) - :not :to-be nil) - (delete-process (get-buffer-process client-buffer)))))) + (server-buffer (process-buffer server-process))) + ;; wait for the connection to be established + (nrepl-tests-poll-until (local-variable-p 'nrepl-endpoint server-buffer) 5) + (let ((client-buffer (cider-connect-sibling-cljs + '(:cljs-repl-type not-cljs-initially) + server-buffer))) + (expect (buffer-local-value 'cider-repl-type client-buffer) + :to-equal 'cljs) + (expect (buffer-local-value 'cider-repl-cljs-upgrade-pending client-buffer) + :to-equal t) + (expect (buffer-local-value 'cider-repl-init-function client-buffer) + :not :to-be nil) + (delete-process (get-buffer-process client-buffer))))))) (provide 'cider-tests) diff --git a/test/nrepl-client-tests.el b/test/nrepl-client-tests.el index b8da9bccc..e491f2ba7 100644 --- a/test/nrepl-client-tests.el +++ b/test/nrepl-client-tests.el @@ -152,13 +152,10 @@ server-buffer)))) ;; server up and running - (nrepl-tests-sleep-until 2 (eq (process-status server-process) 'run)) - (expect (process-status server-process) - :to-equal 'run) + (nrepl-tests-poll-until (eq (process-status server-process) 'run) 2) ;; server has reported its endpoint - (nrepl-tests-sleep-until 2 server-endpoint) - (expect server-endpoint :not :to-be nil) + (nrepl-tests-poll-until server-endpoint 2) (expect (plist-get (process-plist server-process) :cider--nrepl-server-ready) :to-equal t) (condition-case error-details @@ -183,8 +180,8 @@ (delete-process process-client) ;; server process has been signalled - (nrepl-tests-sleep-until 4 (member (process-status server-process) - '(exit signal))) + (nrepl-tests-poll-until (member (process-status server-process) + '(exit signal)) 4) (expect (let ((status (process-status server-process))) (if (eq system-type 'windows-nt) (eq status 'exit) diff --git a/test/utils/nrepl-tests-utils.el b/test/utils/nrepl-tests-utils.el index 549476d2d..f0891eed3 100644 --- a/test/utils/nrepl-tests-utils.el +++ b/test/utils/nrepl-tests-utils.el @@ -25,6 +25,7 @@ ;;; Code: +(require 'cl-lib) (require 'nrepl-client) (defmacro nrepl-tests-log/init! (enable? name log-filename &optional clean?) @@ -59,14 +60,18 @@ same file). `(defmacro ,log-symbol (fmt &rest rest) '())))) -(defmacro nrepl-tests-sleep-until (timeout-secs condition) - "Sleep for up to TIMEOUT-SECS or until CONDITION becomes true. It wakes -up every 0.2 seconds to check for CONDITION." +(defmacro nrepl-tests-poll-until (condition timeout-secs) + "Poll every 0.2 secs until CONDITION becomes true or error out if TIMEOUT-SECS elapses." (let* ((interval-secs 0.2) (count (truncate (/ timeout-secs interval-secs)))) `(cl-loop repeat ,count - until ,condition - do (sleep-for ,interval-secs)))) + for condition = ,condition + if condition + return condition + else + do (sleep-for ,interval-secs) + finally (error ":cider-tests-poll-until-errored :timed-out-after-secs %d :waiting-for %S" + ,timeout-secs (quote ,condition))))) (defun nrepl-server-mock-invocation-string () "Return a shell command that can be used by nrepl-start-srever-process to @@ -101,15 +106,11 @@ calling process." (defun nrepl-start-mock-server-process () "Start and return the mock nrepl server process." - (let* ((up? nil) - (server-process (nrepl-start-server-process + (let ((server-process (nrepl-start-server-process default-directory (nrepl-server-mock-invocation-string) - (lambda (server-buffer) - (setq up? t)))) - server-buffer (process-buffer server-process)) - ;; server has reported its endpoint - (nrepl-tests-sleep-until 2 up?) + (lambda (_server-buffer) + (message ":nrepl-mock-server-process-started..."))))) server-process)) (provide 'nrepl-tests-utils)