suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Yet another try at ensuring that this concurrency works.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2015-11-10 13:34:45 -05:00
parent 596b05146c
commit 04c0c59d27
1 changed files with 16 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
pkgs/racket-test/tests/pkg/tests-locking.rkt
View File

@ -14,38 +14,41 @@
;; Step 1: Start a special server that waits for our signal to respond
(initialize-catalogs)
(define okay-to-start?-sema (make-semaphore))
(define okay-to-respond?-sema (make-semaphore))
(define okay-to-quit?-sema (make-semaphore))
(define succeed-catalog (make-channel))
(define fail-catalog (make-channel))
(thread
(λ ()
(serve/servlet (pkg-index/basic
(λ (pkg-name)
(semaphore-post okay-to-start?-sema)
(semaphore-wait okay-to-respond?-sema)
(channel-put fail-catalog 'go)
(sync fail-catalog) ;; => 'continue
(define r (hash-ref *index-ht-1* pkg-name #f))
r)
(λ () *index-ht-1*))
#:command-line? #t
#:servlet-regexp #rx""
#:port 9967)
(semaphore-wait okay-to-quit?-sema)
(semaphore-wait okay-to-quit?-sema)))
#:port 9967)))
;; Step 2: Assign it as our server
$ "raco pkg config --set catalogs http://localhost:9967"
$ "raco pkg show pkg-test1"
;; Step 3: Start an installation request in the background
(thread
(λ ()
(shelly-begin
$ "raco pkg install pkg-test1")
(semaphore-post okay-to-quit?-sema)))
(semaphore-wait okay-to-start?-sema)
$ "raco pkg install pkg-test1"
$ "raco pkg show pkg-test1")
(channel-put succeed-catalog 'done)))
(sync fail-catalog) ;; => 'go
;; Step 4: Start the installation request that will fail
$ "raco pkg install pkg-test1" =exit> 1
;; Step 5: Free the other one
(semaphore-post okay-to-respond?-sema)
(semaphore-post okay-to-quit?-sema))))
(channel-put fail-catalog 'continue)
(sync succeed-catalog) ;; => 'done
)))