Adjust api-with-driver-test for safari

Hit our test-server instead of a `file:` to appease GitHub Actions safari limitations.
clj-commons · Mar 17, 2024 · 21ab7aa · 21ab7aa
1 parent ceda6b3
commit 21ab7aa
Show file tree

Hide file tree

Showing 2 changed files with 247 additions and 243 deletions.
diff --git a/test/etaoin/api_test.clj b/test/etaoin/api_test.clj
@@ -56,10 +56,10 @@
   (with-open [sock (ServerSocket. 0)]
     (.getLocalPort sock)))
 
-(def test-server-port (find-available-port))
+(def ^:dynamic *test-server-port* nil)
 
-(defn- test-server-url [path]
-  (format "http://localhost:%d/%s" test-server-port path))
+(defn test-server-url [path]
+  (format "http://localhost:%d/%s" *test-server-port* path))
 
 ;; tests failed in safari 13.1.1 https://bugs.webkit.org/show_bug.cgi?id=202589 use STP newest
 (defn fixture-browsers [f]
@@ -83,24 +83,25 @@
   (f))
 
 (defn test-server [f]
-  (let [proc (p/process {:out :inherit :err :inherit}
-                        "bb test-server --port" test-server-port)]
-    (let [deadline (+ (System/currentTimeMillis) 15000)
-          test-url (test-server-url "test.html") ]
-          (loop []
-            (let [resp (try (client/http-request {:method :get :url test-url})
-                            (catch Throwable _ :not-ready))]
-              (when (= :not-ready resp)
-                (if (< (System/currentTimeMillis) deadline)
-                  (do
-                    (println "- waiting for test-server to be ready at" test-url)
-                    (Thread/sleep 1000)
-                    (recur))
-                  (throw (ex-info "Timed out waiting for ready test server" {}))))))
-          (println "Test server ready"))
-    (f)
-    (p/destroy proc)
-    @proc))
+  (binding [*test-server-port* (find-available-port)]
+    (let [proc (p/process {:out :inherit :err :inherit}
+                          "bb test-server --port" *test-server-port*)]
+      (let [deadline (+ (System/currentTimeMillis) 15000)
+            test-url (test-server-url "test.html") ]
+        (loop []
+          (let [resp (try (client/http-request {:method :get :url test-url})
+                          (catch Throwable _ :not-ready))]
+            (when (= :not-ready resp)
+              (if (< (System/currentTimeMillis) deadline)
+                (do
+                  (println "- waiting for test-server to be ready at" test-url)
+                  (Thread/sleep 1000)
+                  (recur))
+                (throw (ex-info "Timed out waiting for ready test server" {}))))))
+        (println "Test server ready"))
+      (f)
+      (p/destroy proc)
+      @proc)))
 
 (use-fixtures
   :once