Make atomic operation scope wider for the socket selector manipulation

Increasing timeout duration of tests

Author: ktakashi

ext/socket/socket-selector.incl

@@ -4,7 +4,6 @@ static int selector_sockets(SgSocketSelector *selector)
   /* filter closed socket */
   SgObject h = SG_NIL, t = SG_NIL, cp;
   int i = 0;
-  Sg_LockMutex(&selector->lock);
   SG_FOR_EACH(cp, selector->sockets) {
     SgObject slot = SG_CAR(cp);
     if (Sg_SocketOpenP(SG_SOCKET(SG_CAR(slot)))) {
@@ -13,7 +12,6 @@ static int selector_sockets(SgSocketSelector *selector)
     }
   }
   selector->sockets = h;
-  Sg_UnlockMutex(&selector->lock);
   return i;
 }
 
@@ -31,14 +29,12 @@ static void strip_sockets(SgSocketSelector *selector, SgObject slots)
   if (!SG_NULLP(slots)) {
     /* remove the returned sockets from the targets */
     SgObject h = SG_NIL, t = SG_NIL, cp;
-    Sg_LockMutex(&selector->lock);
     SG_FOR_EACH(cp, selector->sockets) {
       if (SG_FALSEP(Sg_Memq(SG_CAR(cp), slots))) {
 	SG_APPEND1(h, t, SG_CAR(cp));
       }
     }
     selector->sockets = h;
-    Sg_UnlockMutex(&selector->lock);
   }
 }
 
@@ -106,13 +102,17 @@ SgObject Sg_SocketSelectorClear(SgSocketSelector *selector)
   if (Sg_SocketSelectorWaitingP(selector)) {
     Sg_Error(UC("There's a thread already waiting for %A"), selector);
   }
+  Sg_LockMutex(&selector->lock);
+
   selector_sockets(selector);
   sockets = selector->sockets;
   SG_FOR_EACH(cp, sockets) {
     remove_socket(selector, SG_SOCKET(SG_CAAR(cp)));
   }
   cp = selector->sockets;
   selector->sockets = SG_NIL;
+
+  Sg_UnlockMutex(&selector->lock);
   return cp;
 }
 
@@ -142,8 +142,8 @@ SgObject Sg_SocketSelectorAdd(SgSocketSelector *selector,
       t->nsec = sp->tv_nsec + usec * 1000;
       to = SG_OBJ(t);
     }
-    slot = Sg_Cons(socket, Sg_Cons(to, data));
     Sg_LockMutex(&selector->lock);
+    slot = Sg_Cons(socket, Sg_Cons(to, data));
     add_socket(selector, slot);
     selector->sockets = Sg_Cons(slot, selector->sockets);
     selector_sockets(selector);
@@ -268,13 +268,14 @@ SgObject Sg_SocketSelectorWait(SgSocketSelector *selector, SgObject timeout)
   }
 
   selector->waiting = TRUE;
-  Sg_UnlockMutex(&selector->lock);
 
  retry:
+  Sg_UnlockMutex(&selector->lock);
   r = selector_wait(selector, n, sp);
+
+  Sg_LockMutex(&selector->lock);
   selector->waiting = FALSE;
   if (SG_NULLP(r) && selector->retry) {
-    Sg_LockMutex(&selector->lock);
     /*
       socket is added during waiting. here we do
       - update timeout
@@ -304,7 +305,6 @@ SgObject Sg_SocketSelectorWait(SgSocketSelector *selector, SgObject timeout)
     }
 
     selector->waiting = TRUE;
-    Sg_UnlockMutex(&selector->lock);
 
     goto retry;
   } else {
@@ -324,6 +324,7 @@ SgObject Sg_SocketSelectorWait(SgSocketSelector *selector, SgObject timeout)
     strip_sockets(selector, strip);
   }
 
+  Sg_UnlockMutex(&selector->lock);
   return Sg_Values2(r, timedout);
 }
 

ext/socket/test.scm

@@ -418,6 +418,7 @@
   (define delay 0.01) ;; 10ms
   (define server (make-server-socket "0"))
   (define selector (make-socket-selector))
+  (define timeouts (make-atomic-fixnum 0))
   (define (echo-back s) (socket-send s (socket-recv s 255)))
   (define end? #f)
   (define t (thread-start!
@@ -438,6 +439,7 @@
 	    (let-values (((socks timed-out) (socket-selector-wait! selector)))
 	      (for-each echo-back (map car socks))
 	      (for-each (lambda (s)
+			  (socket-send s #vu8(0))
 			  (atomic-fixnum-inc! result-to)
 			  (socket-shutdown s SHUT_RDWR)
 			  (socket-close s))
@@ -451,9 +453,9 @@
       (lambda ()
 	(let ((s (make-client-socket "localhost" (server-service server)))
 	      (msg (string->utf8 (string-append "hello " (number->string i)))))
-	  (socket-set-read-timeout! s 100) ;; 100ms
+	  (socket-set-read-timeout! s 500) ;; 500ms
 	  (thread-sleep! delay)
-	  (guard (e (else #t))
+	  (guard (e (else (atomic-fixnum-inc! timeouts) #t))
 	    (socket-send s msg)
 	    (when (bytevector=? (socket-recv s 255) msg)
 	      (atomic-fixnum-inc! result)))
@@ -477,6 +479,9 @@
   (socket-shutdown server SHUT_RDWR)
   (socket-close server)
 
+  (test-equal (format "timeouts (count = ~a, timeout = ~a)" count timeout)
+	      0 (atomic-fixnum-load timeouts))
+
   (values (atomic-fixnum-load result) (atomic-fixnum-load result-to)))
 
 (let-values (((r rt) (selector-test 500)))

test/tests/net/socket.scm

@@ -237,7 +237,7 @@
        (make-thread
 	(lambda ()
 	  (let ((s (make-client-socket "localhost" server-port
-				       (socket-options (read-timeout 100))))
+				       (socket-options (read-timeout 500))))
 		(msg (string->utf8
 		      (string-append "Hello world " (number->string i)))))
 	    (guard (e (else #;(print e) s))