guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 13/13: socket test should not throw unresolved outside o


From: Mike Gran
Subject: [Guile-commits] 13/13: socket test should not throw unresolved outside of a test
Date: Thu, 21 Jan 2021 19:06:19 -0500 (EST)

mike121 pushed a commit to branch master
in repository guile.

commit 91d4d311846b640efdd5705eb0c36217e373c01a
Author: Michael Gran <spk121@yahoo.com>
AuthorDate: Wed Dec 30 06:00:35 2020 -0800

    socket test should not throw unresolved outside of a test
    
    * test-suite/tests/00-socket.test: don't throw unresolved outside of a
        test
---
 test-suite/tests/00-socket.test | 37 +++++++++++++++++++------------------
 1 file changed, 19 insertions(+), 18 deletions(-)

diff --git a/test-suite/tests/00-socket.test b/test-suite/tests/00-socket.test
index 3657628..9d45109 100644
--- a/test-suite/tests/00-socket.test
+++ b/test-suite/tests/00-socket.test
@@ -264,24 +264,25 @@
 
        (force-output (current-output-port))
        (force-output (current-error-port))
-       (if server-listening?
-            (let ((pid (primitive-fork-if-available)))
-             ;; Spawn a server process.
-             (case pid
-               ((-1) (throw 'unresolved))
-               ((0)   ;; the kid:  serve two connections and exit
-                (let serve ((conn
-                             (false-if-exception (accept server-socket)))
-                            (count 1))
-                  (if (not conn)
-                      (exit 1)
-                      (if (> count 0)
-                          (serve (false-if-exception (accept server-socket))
-                                 (- count 1)))))
-                (exit 0))
-               (else  ;; the parent
-                (set! server-pid pid)
-                #t))))
+       (when server-listening?
+          (let ((pid (primitive-fork-if-available)))
+           ;; Spawn a server process.
+           (case pid
+             ((-1)  ;; fork not available
+               #f)
+             ((0)   ;; the kid:  serve two connections and exit
+              (let serve ((conn
+                           (false-if-exception (accept server-socket)))
+                          (count 1))
+                (if (not conn)
+                    (exit 1)
+                    (if (> count 0)
+                        (serve (false-if-exception (accept server-socket))
+                               (- count 1)))))
+              (exit 0))
+             (else  ;; the parent
+              (set! server-pid pid)
+              #t))))
 
        (pass-if "connect"
          (if (not server-pid)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]