Skip to content

refactor: add Tests variant to Ml_sources.Origin.t #12682

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open

refactor: add Tests variant to Ml_sources.Origin.t #12682

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
70 changes: 52 additions & 18 deletions src/dune_rules/ml_sources.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,23 +5,27 @@ module Origin = struct
type t =
| Library of Library.t
| Executables of Executables.t
| Tests of Tests.t
| Melange of Melange_stanzas.Emit.t

let loc = function
| Library l -> l.buildable.loc
| Executables e -> e.buildable.loc
| Tests t -> t.exes.buildable.loc
| Melange mel -> mel.loc
;;

let preprocess = function
| Library l -> l.buildable.preprocess
| Executables e -> e.buildable.preprocess
| Tests t -> t.exes.buildable.preprocess
| Melange mel -> mel.preprocess
;;

let to_dyn = function
| Library _ -> Dyn.variant "Library" [ Dyn.Opaque ]
| Executables _ -> Dyn.variant "Executables" [ Dyn.Opaque ]
| Tests _ -> Dyn.variant "Tests" [ Dyn.Opaque ]
| Melange _ -> Dyn.variant "Melange" [ Dyn.Opaque ]
;;
end
Expand Down Expand Up @@ -58,10 +62,11 @@ module Per_stanza = struct
type groups =
{ libraries : Library.t group_part list
; executables : Executables.t group_part list
; tests : Tests.t group_part list
; melange_emits : Melange_stanzas.Emit.t group_part list
}

let make { libraries = libs; executables = exes; melange_emits = emits } =
let make { libraries = libs; executables = exes; tests; melange_emits = emits } =
let libraries, libraries_by_obj_dir =
List.fold_left
libs
Expand All @@ -84,17 +89,29 @@ module Per_stanza = struct
by_id, by_obj_dir)
in
let executables =
match
String.Map.of_list_map exes ~f:(fun (part : Executables.t group_part) ->
let first_exe = snd (Nonempty_list.hd part.stanza.names) in
let origin : Origin.t = Executables part.stanza in
first_exe, (origin, part.modules, part.obj_dir))
with
| Ok x -> x
| Error (name, _, part) ->
let entries =
List.concat
[ List.map exes ~f:(fun (part : Executables.t group_part) ->
let first_exe = snd (Nonempty_list.hd part.stanza.names) in
let origin : Origin.t = Executables part.stanza in
first_exe, (origin, part.modules, part.obj_dir, part.stanza.buildable.loc))
; List.map tests ~f:(fun (part : Tests.t group_part) ->
let first_exe = snd (Nonempty_list.hd part.stanza.exes.names) in
let origin : Origin.t = Tests part.stanza in
( first_exe
, (origin, part.modules, part.obj_dir, part.stanza.exes.buildable.loc) ))
]
in
match String.Map.of_list entries with
| Ok map ->
String.Map.map map ~f:(fun (origin, modules, obj_dir, _loc) ->
origin, modules, obj_dir)
| Error (name, (_, _, _, loc1), (_, _, _, loc2)) ->
User_error.raise
~loc:part.stanza.buildable.loc
[ Pp.textf "Executable %S appears for the second time in this directory" name ]
~loc:loc1
[ Pp.textf "Executable %S appears for the second time in this directory" name
; Pp.textf "Already defined at %s" (Loc.to_file_colon_line loc2)
]
in
let melange_emits =
match
Expand All @@ -118,6 +135,8 @@ module Per_stanza = struct
by_path (Library part.stanza, part.dir) part.sources)
; List.rev_concat_map exes ~f:(fun part ->
by_path (Executables part.stanza, part.dir) part.sources)
; List.rev_concat_map tests ~f:(fun part ->
by_path (Tests part.stanza, part.dir) part.sources)
; List.rev_concat_map emits ~f:(fun part ->
by_path (Melange part.stanza, part.dir) part.sources)
]
Expand Down Expand Up @@ -252,7 +271,7 @@ let find_origin (t : t) ~libs path =
| Some origins ->
Memo.List.filter_map origins ~f:(fun (origin, dir) ->
match origin with
| Executables _ | Melange _ -> Memo.return (Some origin)
| Executables _ | Tests _ | Melange _ -> Memo.return (Some origin)
| Library lib ->
let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in
Lib.DB.available_by_lib_id libs (Local (Library.to_lib_id ~src_dir lib))
Expand Down Expand Up @@ -461,14 +480,18 @@ let modules_of_stanzas =
| `Skip -> loop l acc
| `Library y -> loop l { acc with libraries = y :: acc.libraries }
| `Executables y -> loop l { acc with executables = y :: acc.executables }
| `Tests y -> loop l { acc with tests = y :: acc.tests }
| `Melange_emit y -> loop l { acc with melange_emits = y :: acc.melange_emits })
in
fun l -> loop l { libraries = []; executables = []; melange_emits = [] }
fun l -> loop l { libraries = []; executables = []; tests = []; melange_emits = [] }
in
fun l ->
let { Per_stanza.libraries; executables; melange_emits } = rev_filter_partition l in
let { Per_stanza.libraries; executables; tests; melange_emits } =
rev_filter_partition l
in
{ Per_stanza.libraries = List.rev libraries
; executables = List.rev executables
; tests = List.rev tests
; melange_emits = List.rev melange_emits
}
in
Expand Down Expand Up @@ -496,6 +519,12 @@ let modules_of_stanzas =
in
`Executables { Per_stanza.stanza = exes; sources; modules; obj_dir; dir }
in
let make_tests ~dir ~expander ~modules ~project tests =
let+ result = make_executables ~dir ~expander ~modules ~project tests.Tests.exes in
match result with
| `Executables group_part -> `Tests { group_part with stanza = tests }
| _ -> assert false
Comment on lines 497 to +526
Copy link
Member

@shonfeder shonfeder Nov 5, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Rather than reusing the make_executables function, constructing the wrong data structure, and then unwrapping it to make the updates to correct it, it seems to me like it would be cleaner to factor out the logic that produces the wrapped record Per_stanza record, then down on lines 563 and 564, have

         | Executables.T exes -> `Executables (make_per_stanza ~dir ~expander ~modules ~project exes)
         | Tests.T tests -> `Tests (make_per_stanza ~dir ~expander ~modules ~project tests)

Copy link
Collaborator Author

@Alizter Alizter Nov 14, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think that would be sensible if tests stanzas were a lot more different than the executables stanza, but they are really the same with one extra piece of data. The way everything is laid out means its tricky to reuse stuff due to the polymorphism. I reckon the whole thing could be ripped apart and better data structures introduced, but that's out of scope for this PR.

If you however see a way to do it, and it doesn't introduce a lot of one time used functions in the file I would be open to it, but at this point its not clear to me.

in
fun stanzas ~expander ~project ~dir ~libs ~lookup_vlib ~modules ~include_subdirs ->
Memo.parallel_map stanzas ~f:(fun stanza ->
let enabled_if =
Expand Down Expand Up @@ -532,7 +561,7 @@ let modules_of_stanzas =
let obj_dir = Library.obj_dir lib ~dir in
`Library { Per_stanza.stanza = lib; sources; modules; dir; obj_dir }
| Executables.T exes -> make_executables ~dir ~expander ~modules ~project exes
| Tests.T { exes; _ } -> make_executables ~dir ~expander ~modules ~project exes
| Tests.T tests -> make_tests ~dir ~expander ~modules ~project tests
| Melange_stanzas.Emit.T mel ->
let obj_dir = Obj_dir.make_melange_emit ~dir ~name:mel.target in
let+ sources, modules =
Expand Down Expand Up @@ -652,9 +681,14 @@ let make
part.stanza, part.modules, part.obj_dir)
in
let exes =
List.map
modules_of_stanzas.executables
~f:(fun (part : _ Per_stanza.group_part) -> part.modules, part.obj_dir)
List.concat
[ List.map
modules_of_stanzas.executables
~f:(fun { Per_stanza.modules; obj_dir; _ } -> modules, obj_dir)
; List.map
modules_of_stanzas.tests
~f:(fun { Per_stanza.modules; obj_dir; _ } -> modules, obj_dir)
]
in
Artifacts_obj.make
~dir
Expand Down
1 change: 1 addition & 0 deletions src/dune_rules/ml_sources.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ module Origin : sig
type t =
| Library of Library.t
| Executables of Executables.t
| Tests of Tests.t
| Melange of Melange_stanzas.Emit.t

val preprocess : t -> Preprocess.With_instrumentation.t Preprocess.Per_module.t
Expand Down
1 change: 1 addition & 0 deletions src/dune_rules/top_module.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -42,6 +42,7 @@ let find_module sctx src =
@@ fun () ->
match origin with
| Executables exes -> Exe_rules.rules ~sctx ~dir_contents ~scope ~expander exes
| Tests tests -> Exe_rules.rules ~sctx ~dir_contents ~scope ~expander tests.exes
| Library lib -> Lib_rules.rules lib ~sctx ~dir_contents ~expander ~scope
| Melange mel ->
Melange_rules.setup_emit_cmj_rules ~sctx ~dir_contents ~expander ~scope mel
Expand Down
Loading