35fffb09d0
The bug was an induced failure in the http server, to test retry support, triggered another run of half of the synchronization protocol, leading to a stuck state.
60 lines
1.9 KiB
Racket
60 lines
1.9 KiB
Racket
#lang racket/base
|
|
(require web-server/http
|
|
web-server/servlet-env
|
|
"basic-index.rkt"
|
|
"shelly.rkt"
|
|
"util.rkt")
|
|
|
|
(this-test-is-run-by-the-main-test)
|
|
|
|
(pkg-tests
|
|
(with-fake-root
|
|
(shelly-case
|
|
"A lock is used to guarantee serial access to the package database"
|
|
|
|
;; Step 1: Start a special server that waits for our signal to respond
|
|
(initialize-catalogs)
|
|
|
|
(define succeed-catalog (make-channel))
|
|
(define fail-catalog (make-channel))
|
|
|
|
(thread
|
|
(λ ()
|
|
(define first-time? #t)
|
|
(serve/servlet (pkg-index/basic
|
|
(λ (pkg-name)
|
|
;; only do the synchronization protocol once:
|
|
;; `pkg-index/basic` can decide to return 500
|
|
;; which triggers a retry, and since no one is
|
|
;; posting a second time to these channels, we
|
|
;; would get stuck.
|
|
(when first-time?
|
|
(channel-put fail-catalog 'go)
|
|
(define v (sync fail-catalog)) ;; => 'continue
|
|
(set! first-time? #f))
|
|
(define r (hash-ref *index-ht-1* pkg-name #f))
|
|
r)
|
|
(λ () *index-ht-1*))
|
|
#:command-line? #t
|
|
#:servlet-regexp #rx""
|
|
#:port 9967)))
|
|
|
|
;; Step 2: Assign it as our server
|
|
$ "raco pkg config --set catalogs http://localhost:9967"
|
|
|
|
;; Step 3: Start an installation request in the background
|
|
(thread
|
|
(λ ()
|
|
(shelly-begin
|
|
$ "raco pkg install 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
|
|
(channel-put fail-catalog 'continue)
|
|
(sync succeed-catalog) ;; => 'done
|
|
)))
|