Deforest foreign_sources

Signed-off-by: Rudi Grinberg <[email protected]>

CHANGES.md

@@ -1,6 +1,9 @@
 Unreleased
 ----------
 
+- Fix `foreign_stubs` inside a `tests` stanza. Previously, dune would crash
+  when this field was present (#4942, fix #4946, @rgrinberg)
+
 - Add a `%{toolchain}` expansion variable (#4899, fixes #3949, @rgrinberg)
 
 - Include dependencies of executables when creating toplevels (either `dune

otherlibs/stdune-unstable/list.ml

@@ -39,6 +39,26 @@ let filteri l ~f =
 
 let concat_map l ~f = concat (map l ~f)
 
+let unordered_concat =
+  let rec outer acc = function
+    | [] -> acc
+    | x :: xs -> inner acc xs x
+  and inner acc ys = function
+    | [] -> outer acc ys
+    | x :: xs -> inner (x :: acc) ys xs
+  in
+  fun l -> outer [] l
+
+let unordered_concat_map =
+  let rec outer ~f acc = function
+    | [] -> acc
+    | x :: xs -> inner ~f acc xs (f x)
+  and inner ~f acc ys = function
+    | [] -> outer ~f acc ys
+    | x :: xs -> inner ~f (x :: acc) ys xs
+  in
+  fun l ~f -> outer ~f [] l
+
 let rec rev_map_append l1 l2 ~f =
   match l1 with
   | [] -> l2

otherlibs/stdune-unstable/list.mli

@@ -18,6 +18,10 @@ val filteri : 'a t -> f:(int -> 'a -> bool) -> 'a t
 
 val concat_map : 'a t -> f:('a -> 'b t) -> 'b t
 
+val unordered_concat : 'a t t -> 'a t
+
+val unordered_concat_map : 'a t -> f:('a -> 'b t) -> 'b t
+
 val partition_map : 'a t -> f:('a -> ('b, 'c) Either.t) -> 'b t * 'c t
 
 val rev_map_append : 'a t -> 'b t -> f:('a -> 'b) -> 'b t

src/dune_rules/foreign_sources.ml

@@ -143,6 +143,38 @@ let make (d : _ Dir_with_dune.t) ~(sources : Foreign.Sources.Unresolved.t)
           (libs, foreign_libs, (exe, all) :: exes)
         | _ -> acc)
   in
+  let () =
+    let objects =
+      List.concat
+        [ List.rev_map libs ~f:snd
+        ; List.rev_map foreign_libs ~f:(fun (_, (_, sources)) -> sources)
+        ; List.rev_map exes ~f:snd
+        ]
+      |> List.unordered_concat_map ~f:(fun sources ->
+             String.Map.to_list_map sources ~f:(fun _ (loc, source) ->
+                 (Foreign.Source.object_name source ^ lib_config.ext_obj, loc)))
+    in
+    match String.Map.of_list objects with
+    | Ok _ -> ()
+    | Error (path, loc, another_loc) ->
+      User_error.raise ~loc
+        [ Pp.textf
+            "Multiple definitions for the same object file %S. See another \
+             definition at %s."
+            path
+            (Loc.to_file_colon_line another_loc)
+        ]
+        ~hints:
+          [ Pp.text
+              "You can avoid the name clash by renaming one of the objects, or \
+               by placing it into a different directory."
+          ]
+  in
+  (* TODO: Make this more type-safe by switching to non-empty lists. *)
+  let executables =
+    String.Map.of_list_map_exn exes ~f:(fun (exes, m) ->
+        (snd (List.hd exes.names), m))
+  in
   let libraries =
     match
       Lib_name.Map.of_list_map libs ~f:(fun (lib, m) ->
@@ -175,39 +207,6 @@ let make (d : _ Dir_with_dune.t) ~(sources : Foreign.Sources.Unresolved.t)
           ])
     |> Foreign.Archive.Name.Map.map ~f:snd
   in
-  (* TODO: Make this more type-safe by switching to non-empty lists. *)
-  let executables =
-    String.Map.of_list_map_exn exes ~f:(fun (exes, m) ->
-        (snd (List.hd exes.names), m))
-  in
-  let () =
-    let objects =
-      List.concat
-        [ List.map libs ~f:snd
-        ; List.map foreign_libs ~f:(fun (_, (_, sources)) -> sources)
-        ; List.map exes ~f:snd
-        ]
-      |> List.concat_map ~f:(fun sources ->
-             String.Map.values sources
-             |> List.map ~f:(fun (loc, source) ->
-                    (Foreign.Source.object_name source ^ lib_config.ext_obj, loc)))
-    in
-    match String.Map.of_list objects with
-    | Ok _ -> ()
-    | Error (path, loc, another_loc) ->
-      User_error.raise ~loc
-        [ Pp.textf
-            "Multiple definitions for the same object file %S. See another \
-             definition at %s."
-            path
-            (Loc.to_file_colon_line another_loc)
-        ]
-        ~hints:
-          [ Pp.text
-              "You can avoid the name clash by renaming one of the objects, or \
-               by placing it into a different directory."
-          ]
-  in
   { libraries; archives; executables }
 
 let make (d : _ Dir_with_dune.t) ~include_subdirs ~(lib_config : Lib_config.t)