From 7da506378228e60dfd9b3e6e59e7d0df0eca5037 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Thu, 23 Aug 2012 14:24:28 -0400
Subject: [PATCH] db: added variations of concurrency test

---
 collects/tests/db/db/concurrent.rkt | 30 ++++++++++++++++++++++-------
 1 file changed, 23 insertions(+), 7 deletions(-)

diff --git a/collects/tests/db/db/concurrent.rkt b/collects/tests/db/db/concurrent.rkt
index 5a8684e4fd..cc7805d81e 100644
--- a/collects/tests/db/db/concurrent.rkt
+++ b/collects/tests/db/db/concurrent.rkt
@@ -6,9 +6,17 @@
 (import database^ config^)
 (export test^)
 
-(define (test-concurrency workers)
+(define (test-concurrency workers [threads? #t] [concurrent? #t])
+  ;; if threads?, use threads, else use thunks
+  ;; if serialize?, run threads one at a time, else run all at once
   (unless (ANYFLAGS 'isora 'isdb2)
-    (test-case (format "lots of threads (~s)" workers)
+    (test-case (format "lots of ~a (~s)"
+                       (cond [(and threads? concurrent?)
+                              "concurrent threads"]
+                             [threads?
+                              "serialized threads"]
+                             [else "sequential work"])
+                       workers)
       (call-with-connection
        (lambda (c)
          (query-exec c "create temporary table play_numbers (n integer)")
@@ -17,14 +25,20 @@
          (let ([exns null])
            (parameterize ((uncaught-exception-handler
                            (lambda (e) (set! exns (cons e exns)) ((error-escape-handler)))))
-             (for-each thread-wait
-                       (map thread
-                            (map (mk-worker c 100) (build-list workers add1)))))
+             (let* ([workers (for/list ([i (in-range workers)]) (mk-worker c 100 i))]
+                    [tasks (for/list ([worker (in-list workers)])
+                             (cond [(and threads? concurrent?)
+                                    (let ([thd (thread worker)])
+                                      (lambda () (thread-wait thd)))]
+                                   [threads?
+                                    (lambda () (thread-wait (thread worker)))]
+                                   [else worker]))])
+               (for ([task (in-list tasks)]) (task))))
            (when (pair? exns)
              (raise (make-exn (string-append "exception in thread: " (exn-message (car exns)))
                               (exn-continuation-marks (car exns)))))))))))
 
-(define (((mk-worker c iterations) tid))
+(define ((mk-worker c iterations tid))
   (define insert-pst
     (prepare c (sql "insert into play_numbers (n) values ($1)")))
   (define (insert x) (query-exec c insert-pst x))
@@ -109,5 +123,7 @@
     ;; Tests whether connections are properly locked.
     (test-concurrency 1)
     (test-concurrency 2)
-    (test-concurrency 20)
+    (test-concurrency 20 #t #t)
+    (test-concurrency 20 #t #f)
+    (test-concurrency 20 #f #f)
     (kill-safe-test #t)))