OSL handling for {c,cxx}_names

CHANGES.md

@@ -119,6 +119,10 @@ unreleased
   was prepending paths and thus `$PKG_CONFIG_PATH` set by users could have been
   overridden by homebrew installed libraries (#1785, @andreypopp)
 
+- Disallow c/cxx sources that share an object file in the same stubs archive.
+  This means that `foo.c` and `foo.cpp` can no longer exist in the same library.
+  (#1788, @rgrinberg)
+
 1.6.2 (05/12/2018)
 ------------------
 

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_extension 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 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,47 @@
+open Stdune
+
+module Kind : sig
+  type t =
+    | C
+    | Cxx
+
+  val pp : t Fmt.t
+
+  val split_extension : string -> (string * t) option
+
+  (** [possible_fns t s] returns the possible filenames given the extension-less
+      basenames [s] *)
+  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 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

@@ -0,0 +1,130 @@
+open Stdune
+open Dune_file
+
+module Library = Dune_file.Library
+
+type t =
+  { libraries : C.Sources.t Lib_name.Map.t
+  }
+
+let for_lib t ~dir ~name =
+  match Lib_name.Map.find t.libraries name with
+  | Some m -> m
+  | None ->
+    Exn.code_error "C_sources.for_lib"
+      [ "name", Lib_name.to_sexp name
+      ; "dir", Path.to_sexp dir
+      ; "available", Sexp.Encoder.(list Lib_name.to_sexp)
+                       (Lib_name.Map.keys t.libraries)
+      ]
+
+let empty =
+  { libraries = Lib_name.Map.empty
+  }
+
+let c_name, cxx_name =
+  let make what ~loc s =
+    if match s with
+      | "" | "." | ".."  -> true
+      | _ -> false then
+      Errors.fail loc "%S is not a valid %s name." s what
+    else
+      s
+  in
+  ( make "C"
+  , make "C++"
+  )
+
+module Eval = struct
+  module Value = struct
+    type t = string
+    type key = string
+    let key s = s
+  end
+
+  include Ordered_set_lang.Make_loc(String)(Value)
+end
+
+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_extension 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 (kind : C.Kind.t) (c_sources : C.Source.t String.Map.t)
+              validate osl =
+          Eval.eval_unordered osl
+            ~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) ->
+            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.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
+  let libraries =
+    match
+      Lib_name.Map.of_list_map libs ~f:(fun (lib, m) ->
+        Library.best_name lib, m)
+    with
+    | Ok x -> x
+    | Error (name, _, (lib2, _)) ->
+      Errors.fail lib2.buildable.loc
+        "Library %a appears for the second time \
+         in this directory"
+        Lib_name.pp_quoted name
+  in
+  let () =
+    let rev_map =
+      List.concat_map libs ~f:(fun (_, c_sources) ->
+        String.Map.values c_sources
+        |> List.map ~f:(fun (loc, source) ->
+          (C.Source.path source, loc)))
+      |> Path.Map.of_list
+    in
+    match rev_map with
+    | Ok _ -> ()
+    | Error (_, loc1, loc2) ->
+      Errors.fail loc2
+        "This c stub is already used in another stanza:@\n\
+         @[<v>%a@]@\n"
+        (Fmt.prefix (Fmt.string "- ") Loc.pp_file_colon_line)
+        loc1
+  in
+  { libraries
+  }

src/c_sources.mli

@@ -0,0 +1,17 @@
+open Stdune
+
+type t
+
+val empty : 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_sources:C.Source.t String.Map.t C.Kind.Dict.t
+  -> t