Merge remote-tracking branch 'origin/stable-2.0'
[bpt/guile.git] / test-suite / tests / 00-socket.test
index e74d376..30a0257 100644 (file)
@@ -1,7 +1,7 @@
 ;;;; 00-socket.test --- test socket functions     -*- scheme -*-
 ;;;;
 ;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010,
-;;;;   2011, 2012 Free Software Foundation, Inc.
+;;;;   2011, 2012, 2013 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
          (if (not server-pid)
              (throw 'unresolved)
              (let ((status (cdr (waitpid server-pid))))
-               (eq? 0 (status:exit-val status)))))
+               (eqv? 0 (status:exit-val status)))))
 
        (false-if-exception (delete-file path))
 
           (if (not server-pid)
               (throw 'unresolved)
               (let ((status (cdr (waitpid server-pid))))
-                (eq? 0 (status:exit-val status)))))
+                (eqv? 0 (status:exit-val status)))))
 
         (false-if-exception (delete-file path))
 
            (lambda args
              (let ((errno (system-error-errno args)))
                (cond ((= errno EADDRINUSE) (throw 'unresolved))
+
+                      ;; On Linux-based systems, when `ipv6' support is
+                      ;; missing (for instance, `ipv6' is loaded and
+                      ;; /proc/sys/net/ipv6/conf/all/disable_ipv6 is set
+                      ;; to 1), the socket call above succeeds but
+                      ;; bind(2) fails like this.
+                      ((= errno EADDRNOTAVAIL) (throw 'unresolved))
+
                      (else (apply throw args)))))))
 
        (pass-if "bind/sockaddr"
              (lambda args
                (let ((errno (system-error-errno args)))
                  (cond ((= errno EADDRINUSE) (throw 'unresolved))
+                        ((= errno EADDRNOTAVAIL) (throw 'unresolved))
                        (else (apply throw args))))))))
 
        (pass-if "listen"
          (if (not server-pid)
              (throw 'unresolved)
              (let ((status (cdr (waitpid server-pid))))
-               (eq? 0 (status:exit-val status)))))
+               (eqv? 0 (status:exit-val status)))))
 
        #t)))