0c728e37创建于 2024年10月20日历史提交
open Riot

type Message.t += A | B | C

let rec loop pid msg n =
  if n = 0 then send pid msg
  else (
    yield ();
    loop pid msg (n - 1))

let main () =
  let _ = Logger.start () |> Result.get_ok in
  Logger.set_log_level (Some Info);
  let this = self () in

  let _ =
    spawn (fun () ->
        process_flag (Priority Low);
        loop this A 100)
  in
  let _ =
    spawn (fun () ->
        process_flag (Priority Normal);
        loop this B 100)
  in
  let _ =
    spawn (fun () ->
        process_flag (Priority High);
        loop this C 100)
  in

  let m1 = receive_any ~after:50_000L () in
  let m2 = receive_any ~after:50_000L () in
  let m3 = receive_any ~after:50_000L () in

  match (m1, m2, m3) with
  | C, B, A ->
      Logger.info (fun f -> f "process_priority_test: OK");

      shutdown ()
  | m1, m2, m3 ->
      Logger.error (fun f ->
          f "process_priority_test: messages arrived out of order?\n%S\n%S\n%S"
            (Marshal.to_string m1 []) (Marshal.to_string m2 [])
            (Marshal.to_string m3 []));

      Stdlib.exit 1

(* NOTE(@leostera): this test NEEDS to run on just one scheduler, so we spin up
   no additional workers. The reason is that if we do, then other schedulers
   may pick up lower priority process earlier, and so the message order will be
   different.

   That behavior _is expected_.
*)
let () = Riot.run ~config:(Config.make ~workers:0 ()) @@ main