Fix handling of C_sources for include_subdirs

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

src/c.ml

@@ -0,0 +1,86 @@
+open Stdune
+
+module Kind = struct
+  type t =
+    | C
+    | Cxx
+
+  let pp fmt t : unit =
+    match t with
+    | C -> Format.pp_print_string fmt "c"
+    | Cxx -> Format.pp_print_string fmt "cpp"
+
+  let split_fn fn =
+    match String.lsplit2 fn ~on:'.' with
+    | Some (obj, "c") -> Some (obj, C)
+    | Some (obj, "cpp") -> Some (obj, Cxx)
+    | _ -> None
+
+  let possible_fns t fn =
+    match t with
+    | C -> [fn ^ ".c"]
+    | Cxx -> [fn ^ ".cpp"]
+
+  module Dict = struct
+    type 'a t =
+      { c : 'a
+      ; cxx : 'a
+      }
+
+    let make a =
+      { c = a
+      ; cxx = a
+      }
+
+    let get { c; cxx } = function
+      | C -> c
+      | Cxx -> cxx
+
+    let add t k v =
+      match k with
+      | C -> { t with c = v }
+      | Cxx -> { t with cxx = v }
+
+    let update t k ~f =
+      let v = get t k in
+      add t k (f v)
+
+    let merge t1 t2 ~f =
+      { c = f t1.c t2.c
+      ; cxx = f t1.cxx t2.cxx
+      }
+  end
+end
+
+module Source = struct
+  type t =
+    { kind : Kind.t
+    ; path : Path.t
+    }
+
+  let kind t = t.kind
+  let path t = t.path
+  let src_dir t = Path.parent_exn t.path
+
+  let make ~kind ~path =
+    { kind
+    ; path
+    }
+end
+
+module Sources = struct
+  type t = (Loc.t * Source.t) String.Map.t
+
+  let foreign_objects (t : t) ~dir ~ext_obj =
+    String.Map.keys t
+    |> List.map ~f:(fun c -> Path.relative dir (c ^ ext_obj))
+
+  let split_by_kind t =
+    let (c, cxx) =
+      String.Map.partition t ~f:(fun (_, s) ->
+        match (Source.kind s : Kind.t) with
+        | C -> true
+        | Cxx -> false)
+    in
+    {Kind.Dict. c; cxx}
+end

src/c.mli

@@ -0,0 +1,45 @@
+open Stdune
+
+module Kind : sig
+  type t =
+    | C
+    | Cxx
+
+  val pp : t Fmt.t
+
+  val split_fn : string -> (string * t) option
+
+  val possible_fns : t -> string -> string list
+
+  module Dict : sig
+    type kind
+    type 'a t =
+      { c : 'a
+      ; cxx : 'a
+      }
+
+    val make : 'a -> 'a t
+
+    val update : 'a t -> kind -> f:('a -> 'a) -> 'a t
+
+    val merge : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t
+  end with type kind := t
+end
+
+module Source : sig
+  type t
+
+  val kind : t -> Kind.t
+  val path : t -> Path.t
+  val src_dir : t -> Path.t
+
+  val make : kind:Kind.t -> path:Path.t -> t
+end
+
+module Sources : sig
+  type t = (Loc.t * Source.t) String.Map.t
+
+  val foreign_objects : t -> dir:Path.t -> ext_obj:string -> Path.t list
+
+  val split_by_kind : t -> t Kind.Dict.t
+end

src/c_sources.ml

@@ -3,33 +3,8 @@ open Dune_file
 
 module Library = Dune_file.Library
 
-module Files = struct
-  type 'a t =
-    { c   : 'a
-    ; cxx : 'a
-    }
-
-  let empty =
-    { c = String.Set.empty
-    ; cxx = String.Set.empty
-    }
-
-  let make ~files =
-    String.Set.fold files ~init:empty ~f:(fun fn acc ->
-      match String.lsplit2 fn ~on:'.' with
-      | Some (_, "c") ->
-        { acc with c = String.Set.add acc.c fn }
-      | Some (_, "cpp") ->
-        { acc with cxx = String.Set.add acc.cxx fn }
-      | _ -> acc)
-
-  let foreign_objects { c; cxx } ~dir ~ext_obj =
-    String.Map.(keys c @ keys cxx)
-    |> List.map ~f:(fun c -> Path.relative dir (c ^ ext_obj))
-end
-
 type t =
-  { libraries : (Loc.t * Path.t) String.Map.t Files.t Lib_name.Map.t
+  { libraries : C.Sources.t Lib_name.Map.t
   }
 
 let for_lib t ~dir ~name =
@@ -72,28 +47,55 @@ module Eval = struct
   include Ordered_set_lang.Make_loc(String)(Value)
 end
 
-let make (d : _ Dir_with_dune.t) ~(c_files : String.Set.t Files.t) =
+let load_sources ~dir ~files =
+  let init = C.Kind.Dict.make String.Map.empty in
+  String.Set.fold files ~init ~f:(fun fn acc ->
+    match C.Kind.split_fn fn with
+    | None -> acc
+    | Some (obj, kind) ->
+      let path = Path.relative dir fn in
+      C.Kind.Dict.update acc kind ~f:(fun v ->
+        String.Map.add v obj (C.Source.make ~kind ~path)
+      ))
+
+let make (d : _ Dir_with_dune.t)
+      ~(c_sources : C.Source.t String.Map.t C.Kind.Dict.t) =
   let libs =
     List.filter_map d.data ~f:(fun stanza ->
       match (stanza : Stanza.t) with
       | Library lib ->
-        let eval ext validate (files : String.Set.t) osl =
+        let eval (kind : C.Kind.t) (c_sources : C.Source.t String.Map.t)
+              validate osl =
           Eval.eval_unordered osl
-            ~parse:validate
+            ~parse:(fun ~loc s ->
+              let s = validate ~loc s in
+              let s' = Filename.basename s in
+              if s' <> s then begin
+                Errors.warn loc "relative part of stub are no longer \
+                                 necessary and are ignored."
+              end;
+              s'
+            )
             ~standard:String.Map.empty
           |> String.Map.map ~f:(fun (loc, s) ->
-            let fn = s ^ ext in
-            if String.Set.mem files fn then
-              (loc, Path.relative d.ctx_dir fn)
-            else
-              Errors.fail loc "%s does not exist" fn
+            match String.Map.find c_sources s with
+            | Some source -> (loc, source)
+            | None ->
+              Errors.fail loc "%s does not exist as a C source. \
+                               One of %s must be present"
+                s (String.enumerate_or (C.Kind.possible_fns kind s))
           )
         in
         let names =
           Option.value ~default:Ordered_set_lang.standard in
-        let c = eval ".c" c_name c_files.c (names lib.c_names) in
-        let cxx = eval ".cpp" cxx_name c_files.cxx (names lib.cxx_names) in
-        Some (lib, { Files. c ; cxx })
+        let c = eval C.Kind.C c_sources.c c_name (names lib.c_names) in
+        let cxx = eval C.Kind.Cxx c_sources.cxx cxx_name (names lib.cxx_names) in
+        let all = String.Map.union c cxx ~f:(fun _ (_loc1, c) (loc2, cxx) ->
+          Errors.fail loc2 "%a source file is invalid because %a exists"
+            Path.pp_in_source (C.Source.path cxx)
+            Path.pp_in_source (C.Source.path c)
+        ) in
+        Some (lib, all)
       | _ -> None
     )
   in

src/c_sources.mli

@@ -1,27 +1,17 @@
 open Stdune
 
-module Files : sig
-  type 'a t =
-    { c   : 'a
-    ; cxx : 'a
-    }
-
-  val make : files:String.Set.t -> String.Set.t t
-
-  val foreign_objects
-    :  (Loc.t * Path.t) String.Map.t t
-    -> dir:Path.t
-    -> ext_obj:string
-    -> Path.t list
-end
-
 type t
 
 val empty : t
 
-val for_lib : t -> dir:Path.t -> name:Lib_name.t -> (Loc.t * Path.t) String.Map.t Files.t
+val for_lib : t -> dir:Path.t -> name:Lib_name.t -> C.Sources.t
+
+val load_sources
+  :  dir:Path.t
+  -> files:String.Set.t
+  -> C.Source.t String.Map.t C.Kind.Dict.t
 
 val make
   :  Stanza.t list Dir_with_dune.t
-  -> c_files:String.Set.t Files.t
+  -> c_sources:C.Source.t String.Map.t C.Kind.Dict.t
   -> t

src/dir_contents.ml

@@ -354,8 +354,9 @@ let rec get sctx ~dir =
           ; modules = lazy (Modules.make d
                               ~modules:(modules_of_files ~dir:d.ctx_dir ~files))
           ; mlds = lazy (build_mlds_map d ~files)
-          ; c_sources =
-              lazy (C_sources.make d ~c_files:(C_sources.Files.make ~files))
+          ; c_sources = lazy (
+              C_sources.make d
+                ~c_sources:(C_sources.load_sources ~dir:d.ctx_dir ~files))
           }
         | Some (_, None)
         | None ->
@@ -421,7 +422,29 @@ let rec get sctx ~dir =
         Modules.make d ~modules)
       in
       let c_sources = lazy (
-        assert false
+        let init = C.Kind.Dict.make String.Map.empty in
+        let c_sources =
+          List.fold_left ((dir, files) :: subdirs) ~init
+            ~f:(fun acc (dir, files) ->
+              let sources = C_sources.load_sources ~dir ~files in
+              let f acc sources =
+                String.Map.union acc sources ~f:(fun name x y ->
+                  Errors.fail (Loc.in_file
+                                (match File_tree.Dir.dune_file ft_dir with
+                                  | None ->
+                                    Path.relative (File_tree.Dir.path ft_dir)
+                                      "_unknown_"
+                                  | Some d -> File_tree.Dune_file.path d))
+                    "C file %s appears in several directories:\
+                    @\n- %a\
+                    @\n- %a"
+                    name
+                    Path.pp_in_source (C.Source.src_dir x)
+                    Path.pp_in_source (C.Source.src_dir y))
+              in
+              C.Kind.Dict.merge acc sources ~f)
+        in
+        C_sources.make d ~c_sources
       ) in
       let t =
         { kind = Group_root

src/dir_contents.mli

@@ -23,10 +23,7 @@ end
 (** Modules attached to a library. [name] is the library best name. *)
 val modules_of_library : t -> name:Lib_name.t -> Lib_modules.t
 
-val c_sources_of_library
-  :  t
-  -> name:Lib_name.t
-  -> (Loc.t * Path.t) String.Map.t C_sources.Files.t
+val c_sources_of_library : t -> name:Lib_name.t -> C.Sources.t
 
 (** Modules attached to a set of executables. *)
 val modules_of_executables : t -> first_exe:string -> Executables_modules.t

src/install_rules.ml

@@ -45,7 +45,7 @@ module Gen(P : Params) = struct
                 let foreign_objects =
                   let dir = Obj_dir.obj_dir (Lib.obj_dir lib) in
                   Dir_contents.c_sources_of_library dir_contents ~name
-                  |> C_sources.Files.foreign_objects ~dir ~ext_obj:ctx.ext_obj
+                  |> C.Sources.foreign_objects ~dir ~ext_obj:ctx.ext_obj
                 in
                 Lib.to_dune_lib lib ~dir:(lib_root lib) ~lib_modules
                   ~foreign_objects)

src/lib_archives.ml

@@ -29,7 +29,7 @@ let make ~(ctx : Context.t) ~dir ~dir_contents (lib : Library.t) =
             Dir_contents.c_sources_of_library dir_contents
               ~name:(Library.best_name lib)
           in
-          C_sources.Files.foreign_objects files ~dir ~ext_obj:ctx.ext_obj
+          C.Sources.foreign_objects files ~dir ~ext_obj:ctx.ext_obj
         ) else if Library.has_stubs lib then (
           [ Library.stubs_archive ~dir lib ~ext_lib:ctx.ext_lib ]
         ) else