Search code examples
multithreadingf#deadlock

Deadlock when accessing logger object from async method run synchronously


Following code is trying to do some work and retries if there is an error. There is also a callback on error which is calling a function that logs an error to the console.

When executed, error is logged to console only once and when the program is paused, the main thread is blocked in retryErrorForever and a worker thread is blocked while getting a log.

But why?

module Program

type MyLogger(loggerName: string) =
    member __.Warn fmt =
        Printf.kprintf (printfn "%s: %s" loggerName) fmt

let log = MyLogger("Logger")

let retryErrorForever errorCallback retryTimeout work =
    let rec loop () = async {
        let! result = work

        match result with
        | Error e ->
            errorCallback e
            do! Async.Sleep retryTimeout
            return! loop()
        | Ok x -> return Ok x
    }

    loop ()

let retryWorkUntilOk logError timeout (work: unit -> Result<string, string>) =
    let workflow = async {
        return work ()
    }

    let result =
        retryErrorForever logError timeout workflow
        |> Async.RunSynchronously

    match result with
    | Ok x -> x
    | Error e -> failwith <| sprintf "Cannot doWork: %s" e

let logError error =
    log.Warn "%s" error

let doWork work =
    retryWorkUntilOk logError 1000 work

let errorOnly () : Result<string, string> =
    Error "You have no power here"

let result = doWork errorOnly

[<EntryPoint>]
let main _ =
    printfn "%A" result
    0

Solution

  • When run in interactive, this program does exactly what it's supposed to do: prints "You have no power here" every second forever.

    But if you're compiling it and running the executable, there is one problem: the line let result = ... is evaluated on assembly initialization, before main is even run, and the whole program content is executed during that time. However, assembly initialization is supposed to be synchronous. It can kick off async tasks, but they will not be completed until the static initialization is done - and the way your program is written, static initialization is waiting for those async tasks to complete. So you get a deadlock.

    To fix this, just make the whole thing run from main, not during static initialization. This can be done by making result a function and then calling it from main:

    let result() = doWork errorOnly
    
    [<EntryPoint>]
    let main _ =
        printfn "%A" <| result()
        0