feat(runtest): dune runtest for (tests)

Signed-off-by: Ali Caglayan <[email protected]>

Author: Alizter

.github/workflows/docker-image.yml

@@ -37,7 +37,7 @@ jobs:
 
       - name: Extract metadata (tags, labels) for Docker
         id: meta
-        uses: docker/metadata-action@v5.8.0
+        uses: docker/metadata-action@v5.9.0
         with:
           images: ${{ env.REGISTRY }}/${{ env.IMAGE_NAME }}
 

.github/workflows/multi-repo-build.yml

@@ -0,0 +1,96 @@
+name: Multi-Repo Build
+
+on:
+  workflow_dispatch:
+    inputs:
+      repos:
+        description: 'Space-separated list of GitHub repos (e.g., "ocaml-dune/notty ocaml/ocaml-re")'
+        required: true
+        type: string
+      depext_linux:
+        description: 'Space-separated apt packages for Linux (optional)'
+        required: false
+        type: string
+        default: ''
+      depext_macos:
+        description: 'Space-separated brew packages for macOS (optional)'
+        required: false
+        type: string
+        default: ''
+
+env:
+  EXTRA_NIX_CONFIG: |
+    extra-substituters = https://anmonteiro.nix-cache.workers.dev
+    extra-trusted-public-keys = ocaml.nix-cache.com-1:/xI2h2+56rwFfKyyFVbkJSeGqSIYMC/Je+7XXqGKDIY=
+
+jobs:
+  build:
+    name: Build repos with Dune
+    strategy:
+      fail-fast: false
+      matrix:
+        os:
+          - ubuntu-latest
+          - macos-latest
+    runs-on: ${{ matrix.os }}
+    env:
+      # TODO: Remove
+      DUNE_CONFIG__PKG_BUILD_PROGRESS: enabled
+    steps:
+      - name: Checkout Dune
+        uses: actions/checkout@v5
+
+      - name: Set up Nix
+        uses: nixbuild/nix-quick-install-action@v34
+        with:
+          nix_conf: ${{ env.EXTRA_NIX_CONFIG }}
+
+      - name: Cache Nix store
+        uses: nix-community/cache-nix-action@v6
+        with:
+          primary-key: nix-${{ runner.os }}-nix-build-${{ hashFiles('**/*.nix', '**/flake.lock') }}
+          restore-prefixes-first-match: nix-${{ runner.os }}-nix-build-
+          save: false
+
+      - name: Build Dune
+        run: nix build
+
+      - name: Set up workspace directory
+        run: mkdir workspace
+
+      - name: Clone repositories
+        run: |
+          cd workspace
+          for repo in ${{ inputs.repos }}; do
+            echo "Cloning $repo..."
+            repo_name=$(echo $repo | sed 's/.*\///')
+            git clone https://github.com/$repo.git $repo_name
+          done
+
+      - name: Generate dune-workspace
+        run: |
+          cd workspace
+          cat > dune-workspace <<EOF
+          (lang dune 3.21)
+          (pkg enabled)
+          EOF
+
+          echo "Generated dune-workspace:"
+          cat dune-workspace
+
+      - name: Install system dependencies (Linux)
+        if: runner.os == 'Linux' && inputs.depext_linux != ''
+        run: |
+          sudo apt-get update
+          sudo apt-get install -y ${{ inputs.depext_linux }}
+
+      - name: Install system dependencies (macOS)
+        if: runner.os == 'macOS' && inputs.depext_macos != ''
+        run: |
+          brew install ${{ inputs.depext_macos }}
+
+      - name: Lock dependencies
+        run: cd workspace && nix run .. -- pkg lock
+
+      - name: Build
+        run: cd workspace && nix run .. -- build

bin/build.ml

@@ -98,8 +98,12 @@ let poll_handling_rpc_build_requests ~(common : Common.t) ~config =
          match kind with
          | Build targets ->
            Target.interpret_targets (Common.root common) config setup targets
-         | Runtest dir_or_cram_test_paths ->
-           Runtest_common.make_request ~dir_or_cram_test_paths ~to_cwd:root.to_cwd setup
+         | Runtest test_paths ->
+           Runtest_common.make_request
+             ~contexts:setup.contexts
+             ~scontexts:setup.scontexts
+             ~to_cwd:root.to_cwd
+             ~test_paths
        in
        run_build_system ~common ~request, outcome)
 ;;

bin/import.ml

@@ -39,6 +39,8 @@ include struct
   module Library = Library
   module Melange = Melange
   module Executables = Executables
+  module Dune_load = Dune_load
+  module Dir_contents = Dir_contents
 end
 
 include struct

bin/runtest.ml

@@ -36,17 +36,16 @@ let runtest_info =
 let runtest_term =
   let name = Arg.info [] ~docv:"TEST" in
   let+ builder = Common.Builder.term
-  and+ dir_or_cram_test_paths = Arg.(value & pos_all string [ "." ] name) in
+  and+ test_paths = Arg.(value & pos_all string [ "." ] name) in
   let common, config = Common.init builder in
   match Dune_util.Global_lock.lock ~timeout:None with
   | Ok () ->
-    Build.run_build_command
-      ~common
-      ~config
-      ~request:
-        (Runtest_common.make_request
-           ~dir_or_cram_test_paths
-           ~to_cwd:(Common.root common).to_cwd)
+    Build.run_build_command ~common ~config ~request:(fun setup ->
+      Runtest_common.make_request
+        ~contexts:setup.contexts
+        ~scontexts:setup.scontexts
+        ~to_cwd:(Common.root common).to_cwd
+        ~test_paths)
   | Error lock_held_by ->
     Scheduler.go_without_rpc_server ~common ~config (fun () ->
       let open Fiber.O in
@@ -56,7 +55,7 @@ let runtest_term =
         ~lock_held_by
         builder
         Dune_rpc.Procedures.Public.runtest
-        dir_or_cram_test_paths
+        test_paths
       >>| Rpc.Rpc_common.wrap_build_outcome_exn ~print_on_success:true)
 ;;
 

bin/runtest_common.ml

@@ -1,5 +1,25 @@
 open Import
 
+module Test_kind = struct
+  type t =
+    | Runtest of Path.t
+    | Cram of Path.t * Source.Cram_test.t
+    | Test_executable of Path.t * string (* dir, executable name *)
+
+  let alias ~contexts = function
+    | Cram (dir, cram) ->
+      let name = Dune_engine.Alias.Name.of_string (Source.Cram_test.name cram) in
+      Alias.in_dir ~name ~recursive:false ~contexts dir
+    | Test_executable (dir, exe_name) ->
+      (* CR-someday Alizter: get the proper alias, also check js_of_ocaml
+         runtst aliases? *)
+      let name = Dune_engine.Alias.Name.of_string ("runtest-" ^ exe_name) in
+      Alias.in_dir ~name ~recursive:false ~contexts dir
+    | Runtest dir ->
+      Alias.in_dir ~name:Dune_rules.Alias.runtest ~recursive:true ~contexts dir
+  ;;
+end
+
 let cram_tests_of_dir parent_dir =
   let open Memo.O in
   Source_tree.find_dir parent_dir
@@ -20,13 +40,54 @@ let find_cram_test cram_tests path =
     | Error (Dune_rules.Cram_rules.Missing_run_t _) | Ok _ -> None)
 ;;
 
-let all_tests_of_dir parent_dir =
+let find_test_executable ~sctx ~dir ~ml_file =
+  let open Memo.O in
+  let module_name = Filename.remove_extension ml_file in
+  match Dune_lang.Module_name.of_string_opt module_name with
+  | None -> Memo.return `Not_a_test
+  | Some module_name ->
+    let build_dir =
+      Path.Build.append_source (Super_context.context sctx |> Context.build_dir) dir
+    in
+    let* dir_contents = Dir_contents.get sctx ~dir:build_dir in
+    let* ml_sources = Dir_contents.ocaml dir_contents
+    and* scope = Dir_contents.dir dir_contents |> Dune_rules.Scope.DB.find_by_dir in
+    Dune_rules.Ml_sources.find_origin
+      ml_sources
+      ~libs:(Dune_rules.Scope.libs scope)
+      [ module_name ]
+    >>| (function
+     | Some (Library _ | Executables _ | Melange _) | None -> `Not_a_test
+     | Some (Tests ({ exes; _ } as _test)) ->
+       let exe_names = Nonempty_list.to_list exes.names |> List.map ~f:snd in
+       if List.mem exe_names (Filename.remove_extension ml_file) ~equal:String.equal
+       then `Runnable (Filename.remove_extension ml_file)
+       else (
+         match exe_names with
+         | [ single_exe ] -> `Runnable single_exe
+         | [] | _ :: _ -> `Multiple_executables))
+;;
+
+let all_tests_of_dir ~sctx parent_dir =
   let open Memo.O in
   let+ cram_candidates =
     cram_tests_of_dir parent_dir
     >>| List.filter_map ~f:(fun res ->
       Result.to_option res
       |> Option.map ~f:(fun test -> Source.Cram_test.path test |> Path.Source.to_string))
+  and+ test_executable_candidates =
+    Source_tree.find_dir parent_dir
+    >>= function
+    | None -> Memo.return []
+    | Some source_dir ->
+      Source_tree.Dir.filenames source_dir
+      |> Filename.Set.to_list
+      |> List.filter ~f:(fun f -> String.is_suffix f ~suffix:".ml")
+      |> Memo.List.filter ~f:(fun ml_file ->
+        find_test_executable ~sctx ~dir:parent_dir ~ml_file
+        >>| function
+        | `Runnable _ -> true
+        | `Multiple_executables | `Not_a_test -> false)
   and+ dir_candidates =
     let* parent_source_dir = Source_tree.find_dir parent_dir in
     match parent_source_dir with
@@ -39,59 +100,75 @@ let all_tests_of_dir parent_dir =
         >>| Source_tree.Dir.path
         >>| Path.Source.to_string)
   in
-  List.concat [ cram_candidates; dir_candidates ]
+  List.concat [ cram_candidates; test_executable_candidates; dir_candidates ]
   |> String.Set.of_list
   |> String.Set.to_list
 ;;
 
-let explain_unsuccessful_search path ~parent_dir =
+let explain_unsuccessful_search ~sctx path ~parent_dir =
   let open Memo.O in
-  let+ candidates = all_tests_of_dir parent_dir in
+  let+ candidates = all_tests_of_dir ~sctx parent_dir in
   User_error.raise
     ~hints:(User_message.did_you_mean (Path.Source.to_string path) ~candidates)
     [ Pp.textf "%S does not match any known test." (Path.Source.to_string path) ]
 ;;
 
-(* [disambiguate_test_name path] is a function that takes in a
-   directory [path] and classifies it as either a cram test or a directory to
+(* [disambiguate_test_name path] is a function that takes in a directory [path]
+   and classifies it as either a cram test, test executable, or a directory to
    run tests in. *)
-let disambiguate_test_name path =
+let disambiguate_test_name ~sctx path =
   match Path.Source.parent path with
-  | None -> Memo.return @@ `Runtest (Path.source Path.Source.root)
+  | None -> Memo.return @@ Test_kind.Runtest (Path.source Path.Source.root)
   | Some parent_dir ->
     let open Memo.O in
     let* cram_tests = cram_tests_of_dir parent_dir in
     (match find_cram_test cram_tests path with
      | Some test ->
        (* If we find the cram test, then we request that is run. *)
-       Memo.return (`Cram (parent_dir, test))
+       Memo.return (Test_kind.Cram (Path.source parent_dir, test))
      | None ->
-       (* If we don't find it, then we assume the user intended a directory for
-          @runtest to be used. *)
-       Source_tree.find_dir path
-       >>= (function
-        (* We need to make sure that this directory or file exists. *)
-        | Some _ -> Memo.return (`Runtest (Path.source path))
-        | None -> explain_unsuccessful_search path ~parent_dir))
+       (* Check for test executables *)
+       let filename = Path.Source.basename path in
+       let* test_exe_opt =
+         find_test_executable ~sctx ~dir:parent_dir ~ml_file:filename
+         >>| function
+         | `Runnable exe_name -> Some exe_name
+         | `Multiple_executables ->
+           User_error.raise
+             [ Pp.text "Running multiple test executables at once is not yet supported" ]
+         | `Not_a_test -> None
+       in
+       (match test_exe_opt with
+        | Some exe_name ->
+          (* Found a test executable for this ML file *)
+          Memo.return (Test_kind.Test_executable (Path.source parent_dir, exe_name))
+        | None ->
+          (* If we don't find it, then we assume the user intended a directory for
+             @runtest to be used. *)
+          Source_tree.find_dir path
+          >>= (function
+           (* We need to make sure that this directory or file exists. *)
+           | Some _ -> Memo.return (Test_kind.Runtest (Path.source path))
+           | None -> explain_unsuccessful_search ~sctx path ~parent_dir)))
 ;;
 
-let make_request ~dir_or_cram_test_paths ~to_cwd (setup : Import.Main.build_system) =
-  let contexts = setup.contexts in
-  List.map dir_or_cram_test_paths ~f:(fun dir ->
+let make_request ~contexts ~scontexts ~to_cwd ~test_paths =
+  List.map test_paths ~f:(fun dir ->
     let dir = Path.of_string dir |> Path.Expert.try_localize_external in
-    let open Action_builder.O in
-    let* contexts, alias_kind =
+    let sctx, contexts, src_dir =
       match (Util.check_path contexts dir : Util.checked) with
       | In_build_dir (context, dir) ->
-        let+ res = Action_builder.of_memo (disambiguate_test_name dir) in
-        [ context ], res
+        ( Dune_engine.Context_name.Map.find_exn scontexts (Context.name context)
+        , [ context ]
+        , dir )
       | In_source_dir dir ->
         (* We need to adjust the path here to make up for the current working directory. *)
         let dir =
           Path.Source.L.relative Path.Source.root (to_cwd @ Path.Source.explode dir)
         in
-        let+ res = Action_builder.of_memo (disambiguate_test_name dir) in
-        contexts, res
+        ( Dune_engine.Context_name.Map.find_exn scontexts Context_name.default
+        , contexts
+        , dir )
       | In_private_context _ | In_install_dir _ ->
         User_error.raise
           [ Pp.textf "This path is internal to dune: %s" (Path.to_string_maybe_quoted dir)
@@ -103,17 +180,8 @@ let make_request ~dir_or_cram_test_paths ~to_cwd (setup : Import.Main.build_syst
               (Path.to_string_maybe_quoted dir)
           ]
     in
-    Alias.request
-    @@
-    match alias_kind with
-    | `Cram (dir, cram) ->
-      let alias_name = Source.Cram_test.name cram in
-      Alias.in_dir
-        ~name:(Dune_engine.Alias.Name.of_string alias_name)
-        ~recursive:false
-        ~contexts
-        (Path.source dir)
-    | `Runtest dir ->
-      Alias.in_dir ~name:Dune_rules.Alias.runtest ~recursive:true ~contexts dir)
+    let open Action_builder.O in
+    let* res = Action_builder.of_memo (disambiguate_test_name ~sctx src_dir) in
+    Alias.request (Test_kind.alias ~contexts res))
   |> Action_builder.all_unit
 ;;

bin/runtest_common.mli

@@ -1,10 +1,8 @@
 open Import
 
-(** [make_request ~dir_or_cram_test_paths ~to_cwd] returns a function suitable
-    for passing to [Build_cmd.run_build_system] which runs the tests referred
-    to by the elements of [dir_or_cram_test_paths]. *)
 val make_request
-  :  dir_or_cram_test_paths:string list
+  :  contexts:Context.t list
+  -> scontexts:Super_context.t Context_name.Map.t
   -> to_cwd:string list
-  -> Dune_rules.Main.build_system
+  -> test_paths:string list
   -> unit Action_builder.t

bin/tools/group.ml

@@ -8,7 +8,14 @@ module Exec = struct
     Cmd.group
       info
       (List.map
-         [ Ocamlformat; Ocamllsp; Ocamlearlybird; Odig; Opam_publish; Dune_release ]
+         [ Ocamlformat
+         ; Ocamllsp
+         ; Ocamlearlybird
+         ; Odig
+         ; Opam_publish
+         ; Dune_release
+         ; Ocaml_index
+         ]
          ~f:Tools_common.exec_command)
   ;;
 end