test_lwt_leak.ml

open Printf
open Lwt.Syntax

let show_option o = Option.value ~default:"<none>" o

let create_random_large_value size =
   let chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" in
   let chars_len = String.length chars in
   let result = Bytes.create size in
   for i = 0 to size - 1 do
     Bytes.set result i chars.[Random.int chars_len]
   done ;
   Bytes.to_string result


let create_and_leak_value size =
   let value = create_random_large_value size in
   let key = Lwt.new_key () in
   Lwt.bind (Lwt.return ()) (fun () ->
       let* () =
          Lwt.with_value key (Some value) (fun () ->
              let _ = Lwt.bind (Lwt.return ()) (fun () -> Lwt.return ()) in
              Lwt.return ())
       in
       printf "Gc.full_major ...\n%!" ;
       Gc.full_major () ;
       Lwt.return_unit)


let rec create_and_link_sequentially n size =
   match n with
   | 0 -> Lwt.return_unit
   | _ ->
       let* () = create_and_leak_value size in
       let* () = Lwt_unix.sleep 0.1 in
       create_and_link_sequentially (n - 1) size


let sleeper_and_leaker () =
   let leaker = create_and_link_sequentially 5 (1024 * 1024 * 1) in
   let sleeper = Lwt_unix.sleep 2. in
   let* (), () = Lwt.both sleeper leaker in
   Lwt.return_unit


let () =
   Memtrace.trace_if_requested ~sampling_rate:1e-2 ~context:"lwt leaking test" () ;

   Lwt_main.run @@ sleeper_and_leaker () ;

   printf "Gc.full_major ...\n%!" ;
   Gc.full_major ()