I've been trying to write a Racket GUI tool that makes simultaneous HTTP requests across multiple threads and prints progress as it progresses. I decided to use a semaphore to avoid rate limiting and a mutex to manage the counter.
I encountered deadlocks while developing and attempted to isolate the issue. Eventually I realized that I only encounter the issue when running from Dr Racket. When the below code is run from Dr Racket, multiple threads will state they are trying to acquire a lock, but it has not been released, so the program deadlocks. From Emacs it works as expected.
I'm assuming that my code has a concurrency error that I don't understand, which is only presenting itself when run from Dr Racket for some reason. Could anyone help me understand the issue and fix it?
#lang racket
(require net/http-easy)
(require rebellion/concurrency/lock)
(define (make-get-request)
(let* ([url "http://example.com"]
[response (get url)])
response))
(define downloader-semaphore (make-semaphore 100))
(define progress-lock (make-lock))
(define progress-counter 0)
(define (download-simple-request index total)
(call-with-semaphore downloader-semaphore
(lambda ()
(let ([result (make-get-request)])
(printf "Lock about to be acquired at: ~a\n" (current-inexact-milliseconds))
(lock-acquire! progress-lock)
(printf "Lock acquired at: ~a\n" (current-inexact-milliseconds))
(set! progress-counter (add1 progress-counter))
(printf "~a/~a\n" progress-counter total)
(lock-release! progress-lock)
(printf "Lock released at: ~a\n" (current-inexact-milliseconds))
result))))
(define (parallel-download num-requests)
(let* ([total num-requests]
[channel (make-channel)]
[threads (for/list ([index (in-range num-requests)])
(thread (lambda ()
(channel-put channel (download-simple-request index total)))))]
[results (for/list ([_ (in-range num-requests)])
(channel-get channel))])
results))
(let* ([start-time (current-inexact-milliseconds)]
[num-requests 100] ; Number of times to hit the URL
[_ (parallel-download num-requests)]
[end-time (current-inexact-milliseconds)])
(printf "STARTING TIME ~a\n" start-time)
(printf "ENDING TIME ~a\n" end-time)
(printf "TOTAL TIME ~a\n" (- end-time start-time)))