guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] 01/01: Only run tests that require fork if it is provide


From: Mike Gran
Subject: [Guile-commits] 01/01: Only run tests that require fork if it is provided
Date: Tue, 4 Apr 2017 10:35:31 -0400 (EDT)

mike121 pushed a commit to branch master
in repository guile.

commit 685ca33e2e21ee5fd8917d36772f60a85639fd9b
Author: Michael Gran <address@hidden>
Date:   Tue Apr 4 07:33:41 2017 -0700

    Only run tests that require fork if it is provided
    
    * test-suite/tests/00-repl-server.test (call-with-repl-server): throw if no 
fork provided
    * test-suite/tests/00-socket.test (primitive-fork-if-available): new help 
procedure
      (bind/sockaddr, AF_UNIX/SOCK_STREAM): use helper func
    * test-suite/tests/ports.test ("pipe, fdopen, and line buffering"): throw 
if no fork provided
---
 test-suite/tests/00-repl-server.test |  4 ++--
 test-suite/tests/00-socket.test      | 12 ++++++++----
 test-suite/tests/ports.test          |  4 +++-
 3 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/test-suite/tests/00-repl-server.test 
b/test-suite/tests/00-repl-server.test
index c4c3825..54f518a 100644
--- a/test-suite/tests/00-repl-server.test
+++ b/test-suite/tests/00-repl-server.test
@@ -32,8 +32,8 @@ socket connected to that server."
     (false-if-exception
      (delete-file (sockaddr:path sockaddr)))
 
-    ;; The REPL server requires threads.
-    (unless (provided? 'threads)
+    ;; The REPL server requires thread. The test requires fork.
+    (unless (and (provided? 'threads) (provided? 'fork))
       (throw 'unsupported))
 
     (match (primitive-fork)
diff --git a/test-suite/tests/00-socket.test b/test-suite/tests/00-socket.test
index 211aaaf..7f55ade 100644
--- a/test-suite/tests/00-socket.test
+++ b/test-suite/tests/00-socket.test
@@ -1,7 +1,7 @@
 ;;;; 00-socket.test --- test socket functions     -*- scheme -*-
 ;;;;
 ;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010,
-;;;;   2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+;;;;   2011, 2012, 2013, 2014, 2017 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -161,6 +161,10 @@
                  (number->string (current-time)) "-"
                  (number->string (random 100000))))
 
+(define (primitive-fork-if-available)
+  (if (not (provided? 'fork))
+      -1
+      (primitive-fork)))
 
 (if (defined? 'AF_UNIX)
     (with-test-prefix "AF_UNIX/SOCK_DGRAM"
@@ -261,7 +265,7 @@
        (force-output (current-output-port))
        (force-output (current-error-port))
        (if server-listening?
-           (let ((pid (primitive-fork)))
+            (let ((pid (primitive-fork-if-available)))
              ;; Spawn a server process.
              (case pid
                ((-1) (throw 'unresolved))
@@ -341,7 +345,7 @@
         (force-output (current-output-port))
         (force-output (current-error-port))
         (if server-listening?
-            (let ((pid (primitive-fork)))
+            (let ((pid (primitive-fork-if-available)))
               ;; Spawn a server process.
               (case pid
                 ((-1) (throw 'unresolved))
@@ -439,7 +443,7 @@
        (force-output (current-output-port))
        (force-output (current-error-port))
        (if server-listening?
-           (let ((pid (primitive-fork)))
+            (let ((pid (primitive-fork-if-available)))
              ;; Spawn a server process.
              (case pid
                ((-1) (throw 'unresolved))
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 207c0cf..007f566 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2,7 +2,7 @@
 ;;;; Jim Blandy <address@hidden> --- May 1999
 ;;;;
 ;;;;   Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010,
-;;;;      2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
+;;;;      2011, 2012, 2013, 2014, 2015, 2017 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -638,6 +638,8 @@
 
 (pass-if-equal "pipe, fdopen, and line buffering"
     "foo\nbar\n"
+  (unless (provided? 'fork)
+          (throw 'unresolved))
   (let ((in+out (pipe))
         (pid    (primitive-fork)))
     (if (zero? pid)



reply via email to

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