unikernel/duniverse/dune_/test/expect-tests/dune_file_watcher/dune

@@ -0,0 +1,68 @@
+(library
+ (name dune_file_watcher_tests_lib)
+ (modules dune_file_watcher_tests_lib)
+ (libraries dune_file_watcher base stdune threads.posix stdio spawn unix))
+
+(library
+ (name dune_file_watcher_tests_macos)
+ (modules dune_file_watcher_tests_macos)
+ (inline_tests
+  (enabled_if
+   (and
+    (<> %{env:CI=false} true) ;; in github action, CI=true
+    (= %{system} macosx)))
+  (deps
+   (sandbox always)))
+ (libraries
+  unix
+  dune_file_watcher
+  dune_file_watcher_tests_lib
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  stdune
+  ppx_inline_test.config
+  threads.posix
+  stdio
+  spawn)
+ (preprocess
+  (pps ppx_expect)))
+
+(library
+ (name dune_file_watcher_tests_linux)
+ (modules dune_file_watcher_tests_linux)
+ (inline_tests
+  (enabled_if
+   (= %{system} linux))
+  (deps
+   (sandbox always)))
+ (libraries
+  dune_file_watcher
+  dune_file_watcher_tests_lib
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  stdune
+  ppx_inline_test.config
+  threads.posix
+  stdio
+  spawn
+  unix)
+ (preprocess
+  (pps ppx_expect)))
+
+(library
+ (name dune_file_watcher_tests_patterns)
+ (modules dune_file_watcher_tests_patterns)
+ (inline_tests
+  (deps
+   (sandbox always)))
+ (libraries
+  base
+  dune_config_file
+  dune_file_watcher
+  ppx_expect.config
+  ppx_expect.config_types
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_lib.ml

@@ -0,0 +1,85 @@
+let printf = Printf.printf
+
+open Base
+open Stdune
+
+let critical_section mutex ~f =
+  (* Since 5.0, using "Mutex" with Base open rings an alert and suggests
+     we use "Stdlib.Mutex" instead.
+     Prior to OCaml 5.0, "Stdlib.Mutex" didn't exist, it was just "Mutex".
+     Since 5.1 there is Stdlib.Mutex.protect which replaces this function.
+  *)
+  let module Mutex = Mutex [@alert "-deprecated"] in
+  Mutex.lock mutex;
+  Exn.protect ~f ~finally:(fun () -> Mutex.unlock mutex)
+;;
+
+let init () =
+  let tmp_dir = Stdlib.Filename.concat (Unix.getcwd ()) "working-dir" in
+  let () =
+    try Unix.mkdir tmp_dir 0o777 with
+    | _ -> ()
+  in
+  Unix.chdir tmp_dir;
+  Path.set_root (Path.External.of_string tmp_dir);
+  Path.Build.set_build_dir (Path.Outside_build_dir.of_string "_build")
+;;
+
+let now () = Unix.gettimeofday ()
+
+let retry_loop (type a) ~period ~timeout ~(f : unit -> a option) : a option =
+  let t0 = now () in
+  let rec loop () =
+    match f () with
+    | Some res -> Some res
+    | None ->
+      let t1 = now () in
+      if Base.Float.( < ) (t1 -. t0) timeout
+      then (
+        Thread.delay period;
+        loop ())
+      else None
+  in
+  loop ()
+;;
+
+let get_events ~try_to_get_events ~expected =
+  let collected = ref [] in
+  let done_collecting =
+    match expected with
+    | 0 -> Some `Enough
+    | n ->
+      assert (n > 0);
+      retry_loop ~period:0.01 ~timeout:3.0 ~f:(fun () ->
+        let open Option.O in
+        let* events = try_to_get_events () in
+        collected := !collected @ events;
+        if List.length !collected >= expected then Some `Enough else None)
+  in
+  match done_collecting with
+  | None -> !collected, `Not_enough
+  | Some `Enough ->
+    Thread.delay 0.02;
+    (match try_to_get_events () with
+     | Some events -> collected := !collected @ events
+     | None -> ());
+    !collected, if List.length !collected > expected then `Too_many else `Ok
+;;
+
+let print_events ~try_to_get_events ~expected =
+  let events, status = get_events ~try_to_get_events ~expected in
+  List.iter events ~f:(fun event ->
+    Dune_file_watcher.Fs_memo_event.to_dyn event |> Dyn.to_string |> Stdio.print_endline);
+  match status with
+  | `Ok -> ()
+  | `Not_enough ->
+    printf
+      "Timed out waiting for more events: expected %d, saw %d\n"
+      expected
+      (List.length events)
+  | `Too_many ->
+    printf
+      "Got more events than expected: expected %d, saw %d\n"
+      expected
+      (List.length events)
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_lib.mli

@@ -0,0 +1,7 @@
+val critical_section : Mutex.t -> f:(unit -> 'a) -> 'a
+val init : unit -> unit
+
+val print_events
+  :  try_to_get_events:(unit -> Dune_file_watcher.Fs_memo_event.t list option)
+  -> expected:int
+  -> unit

unikernel/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_linux.ml

@@ -0,0 +1,74 @@
+open Stdune
+open Dune_file_watcher_tests_lib
+
+let%expect_test _ = init ()
+
+let%expect_test _ =
+  let mutex = Mutex.create () in
+  let events_buffer = ref [] in
+  let watcher =
+    Dune_file_watcher.create_default
+      ~scheduler:
+        { spawn_thread = (fun f -> ignore (Thread.create f () : Thread.t))
+        ; thread_safe_send_emit_events_job =
+            (fun job ->
+              critical_section mutex ~f:(fun () ->
+                let events = job () in
+                events_buffer := !events_buffer @ events))
+        }
+      ~watch_exclusions:[]
+      ()
+  in
+  let try_to_get_events () =
+    critical_section mutex ~f:(fun () ->
+      match !events_buffer with
+      | [] -> None
+      | list ->
+        events_buffer := [];
+        Some
+          (List.map list ~f:(function
+             | Dune_file_watcher.Event.Sync _ -> assert false
+             | Queue_overflow -> assert false
+             | Fs_memo_event e -> e
+             | Watcher_terminated -> assert false)))
+  in
+  let print_events n = print_events ~try_to_get_events ~expected:n in
+  (match Dune_file_watcher.add_watch watcher (Path.of_string ".") with
+   | Error _ -> assert false
+   | Ok () -> ());
+  Dune_file_watcher.wait_for_initial_watches_established_blocking watcher;
+  Stdio.Out_channel.write_all "x" ~data:"x";
+  print_events 2;
+  [%expect
+    {|
+{ path = In_source_tree "x"; kind = "Created" }
+{ path = In_source_tree "x"; kind = "File_changed" }
+|}];
+  (* CR-someday aalekseyev: renaming is not detected *)
+  Unix.rename "x" "y";
+  print_events 2;
+  [%expect
+    {|
+    { path = In_source_tree "x"; kind = "Deleted" }
+    { path = In_source_tree "y"; kind = "Created" }
+|}];
+  let (_ : _) = Fpath.mkdir_p "d/w" in
+  (match Dune_file_watcher.add_watch watcher (Path.of_string "d/w") with
+   | Error _ -> assert false
+   | Ok () -> ());
+  Stdio.Out_channel.write_all "d/w/x" ~data:"x";
+  print_events 3;
+  [%expect
+    {|
+    { path = In_source_tree "d"; kind = "Created" }
+    { path = In_source_tree "d/w/x"; kind = "Created" }
+    { path = In_source_tree "d/w/x"; kind = "File_changed" }
+|}];
+  Stdio.Out_channel.write_all "d/w/y" ~data:"y";
+  print_events 2;
+  [%expect
+    {|
+  { path = In_source_tree "d/w/y"; kind = "Created" }
+  { path = In_source_tree "d/w/y"; kind = "File_changed" }
+|}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_macos.ml

@@ -0,0 +1,62 @@
+open Stdune
+open Dune_file_watcher_tests_lib
+
+let%expect_test _ = init ()
+
+let%expect_test _ =
+  let mutex = Mutex.create () in
+  let events_buffer = ref [] in
+  let watcher =
+    Dune_file_watcher.create_default
+      ~fsevents_debounce:0.
+      ~scheduler:
+        { spawn_thread = (fun f -> ignore (Thread.create f () : Thread.t))
+        ; thread_safe_send_emit_events_job =
+            (fun job ->
+              critical_section mutex ~f:(fun () ->
+                let events = job () in
+                events_buffer := !events_buffer @ events))
+        }
+      ~watch_exclusions:[]
+      ()
+  in
+  let try_to_get_events () =
+    critical_section mutex ~f:(fun () ->
+      match !events_buffer with
+      | [] -> None
+      | list ->
+        events_buffer := [];
+        Some
+          (List.filter_map list ~f:(function
+             | Dune_file_watcher.Event.Sync _ -> None
+             | Queue_overflow -> assert false
+             | Fs_memo_event e -> Some e
+             | Watcher_terminated -> assert false)))
+  in
+  let print_events n = print_events ~try_to_get_events ~expected:n in
+  Dune_file_watcher.wait_for_initial_watches_established_blocking watcher;
+  Stdio.Out_channel.write_all "x" ~data:"x";
+  print_events 3;
+  [%expect
+    {|
+    { path = In_source_tree "."; kind = "Created" }
+    { path = In_build_dir "."; kind = "Created" }
+    { path = In_source_tree "x"; kind = "Unknown" } |}];
+  Unix.rename "x" "y";
+  print_events 2;
+  [%expect
+    {|
+    { path = In_source_tree "x"; kind = "Unknown" }
+    { path = In_source_tree "y"; kind = "Unknown" } |}];
+  let (_ : _) = Fpath.mkdir_p "d/w" in
+  Stdio.Out_channel.write_all "d/w/x" ~data:"x";
+  print_events 3;
+  [%expect
+    {|
+    { path = In_source_tree "d"; kind = "Created" }
+    { path = In_source_tree "d/w"; kind = "Created" }
+    { path = In_source_tree "d/w/x"; kind = "Unknown" } |}];
+  Stdio.Out_channel.write_all "d/w/y" ~data:"y";
+  print_events 1;
+  [%expect {| { path = In_source_tree "d/w/y"; kind = "Unknown" } |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_patterns.ml

@@ -0,0 +1,48 @@
+let printf = Printf.printf
+
+let test string =
+  printf
+    "should_exclude(%s) = %b\n"
+    string
+    (Dune_file_watcher.For_tests.should_exclude
+       string
+       ~watch_exclusions:Dune_config_file.Dune_config.standard_watch_exclusions)
+;;
+
+let%expect_test _ =
+  test "file.ml";
+  test "dir/file.ml";
+  test "4913";
+  test "dir/4913";
+  test "4913.ml";
+  test "84913";
+  test "_opam";
+  test "dir/_opam";
+  test "this_is_not_opam";
+  test "#file#";
+  test "dir/#file#";
+  test "dir/#subdir#/file";
+  test ".#file";
+  test ".#foobar.ml";
+  test "dir/.#file";
+  test "dir/.#subdir/file";
+  [%expect
+    {|
+    should_exclude(file.ml) = false
+    should_exclude(dir/file.ml) = false
+    should_exclude(4913) = true
+    should_exclude(dir/4913) = true
+    should_exclude(4913.ml) = false
+    should_exclude(84913) = false
+    should_exclude(_opam) = true
+    should_exclude(dir/_opam) = true
+    should_exclude(this_is_not_opam) = false
+    should_exclude(#file#) = true
+    should_exclude(dir/#file#) = true
+    should_exclude(dir/#subdir#/file) = false
+    should_exclude(.#file) = true
+    should_exclude(.#foobar.ml) = true
+    should_exclude(dir/.#file) = true
+    should_exclude(dir/.#subdir/file) = true
+  |}]
+;;