Unhardcode extensions

CHANGES.md

@@ -15,6 +15,12 @@
   Introducing a new `external_variant` stanza. (#2169, fixes #2134, @TheLortex,
   review by @diml)
 
+- Add proper line directives when copying `.cc` and `.cxx` sources (#2275,
+  @rgrinberg)
+
+- Fix error message for missing C++ sources. The `.cc` extension was always
+  ignored before. (#2275, @rgrinberg)
+
 1.10.0 (04/06/2019)
 -------------------
 

bin/import.ml

@@ -23,7 +23,7 @@ module Build          = Dune.Build
 module Action         = Dune.Action
 module Dep            = Dune.Dep
 module Action_to_sh   = Dune.Action_to_sh
-module Path_dune_lang = Dune.Path_dune_lang
+module Dpath = Dune.Dpath
 module Install        = Dune.Install
 module Watermarks     = Dune.Watermarks
 module Promotion      = Dune.Promotion

bin/print_rules.ml

@@ -47,7 +47,7 @@ let print_rule_sexp ppf (rule : Build_system.Rule.t) =
     Action.for_shell action |> Action.For_shell.encode
   in
   let paths ps =
-    Dune_lang.Encoder.list Path_dune_lang.encode (Path.Set.to_list ps)
+    Dune_lang.Encoder.list Dpath.encode (Path.Set.to_list ps)
   in
   let sexp =
     Dune_lang.Encoder.record (

src/action.ml

@@ -72,10 +72,10 @@ module Prog = struct
   type t = (Path.t, Not_found.t) result
 
   let decode : t Dune_lang.Decoder.t =
-    Dune_lang.Decoder.map Path_dune_lang.decode ~f:Result.ok
+    Dune_lang.Decoder.map Dpath.decode ~f:Result.ok
 
   let encode = function
-    | Ok s -> Path_dune_lang.encode s
+    | Ok s -> Dpath.encode s
     | Error (e : Not_found.t) -> Dune_lang.Encoder.string e.program
 end
 
@@ -91,7 +91,7 @@ module String_with_sexp = struct
   let encode = Dune_lang.Encoder.string
 end
 
-include Action_ast.Make(Prog)(Path_dune_lang)(String_with_sexp)(Ast)
+include Action_ast.Make(Prog)(Dpath)(String_with_sexp)(Ast)
 type program = Prog.t
 type path = Path.t
 type string = String.t

src/action_unexpanded.ml

@@ -23,7 +23,7 @@ let check_mkdir loc path =
       "(mkdir ...) is not supported for paths outside of the workspace:\n\
       \  %a\n"
       (Dune_lang.pp Dune)
-      (List [Dune_lang.unsafe_atom_of_string "mkdir"; Path_dune_lang.encode path])
+      (List [Dune_lang.unsafe_atom_of_string "mkdir"; Dpath.encode path])
 
 module Partial = struct
   module Program = Unresolved.Program

src/alias.ml

@@ -101,6 +101,6 @@ let fmt         = make_standard "fmt"
 let encode { dir ; name } =
   let open Dune_lang.Encoder in
   record
-    [ "dir", Path_dune_lang.encode (Path.build dir)
+    [ "dir", Dpath.encode (Path.build dir)
     ; "name", string name
     ]

src/build_system.ml

@@ -589,9 +589,9 @@ let remove_old_artifacts t ~dir ~(subdirs_to_keep : Subdir_set.t) =
 let no_rule_found =
   fun t ~loc fn ->
     let fail fn ~loc =
-      Errors.fail_opt loc "No rule found for %s" (Utils.describe_target fn)
+      Errors.fail_opt loc "No rule found for %s" (Dpath.describe_target fn)
     in
-    match Utils.analyse_target fn with
+    match Dpath.analyse_target fn with
     | Other _ -> fail fn ~loc
     | Regular (ctx, _) ->
       if String.Map.mem t.contexts ctx then
@@ -930,7 +930,7 @@ The following targets are not:
 
     let corresponding_source_dir ~dir =
       let t = t () in
-      match Utils.analyse_target dir with
+      match Dpath.analyse_target dir with
       | Install _ | Alias _ | Other _ ->
         None
       | Regular (_ctx, sub_dir) ->
@@ -982,7 +982,7 @@ The following targets are not:
 
   let load_dir_step2_exn t ~dir =
     let context_name, sub_dir =
-      match Utils.analyse_path dir with
+      match Dpath.analyse_path dir with
       | Build (Install (ctx, path)) ->
         Context_or_install.Install ctx, path
       | Build (Regular (ctx, path)) ->
@@ -1576,7 +1576,7 @@ end = struct
       ~output:(Allow_cutoff (module Unit))
       ~doc:"Build a file."
       ~input:(module Path)
-      ~visibility:(Public Path_dune_lang.decode)
+      ~visibility:(Public Dpath.decode)
       Async
       build_file_impl
 

src/c.ml

@@ -1,5 +1,7 @@
 open Stdune
 
+let header_ext = ".h"
+
 module Kind = struct
   type t =
     | C
@@ -32,17 +34,24 @@ module Kind = struct
       cxx_version_introduced ~obj ~dune_version ~version_introduced:(1, 10)
     | _ -> Unrecognized
 
-  let possible_fns t fn ~dune_version =
-    match t with
-    | C -> [fn ^ ".c"]
+  let possible_exts ~dune_version = function
+    | C -> [".c"]
     | Cxx ->
-      let cxx = [fn ^ ".cpp"] in
+      let exts = [".cpp"] in
+      let exts =
+        if dune_version >= (1, 10) then
+          ".cc" :: exts
+        else
+          exts
+      in
       if dune_version >= (1, 8) then
-        (fn ^ ".cxx") :: cxx
-      else if dune_version >= (1, 10) then
-        (fn ^ ".cxx") :: (fn ^ ".cc") :: cxx
+        ".cxx" :: exts
       else
-        cxx
+        exts
+
+  let possible_fns t fn ~dune_version =
+    possible_exts t ~dune_version
+    |> List.map ~f:(fun ext -> fn ^ ext)
 
   module Dict = struct
     type 'a t =
@@ -122,3 +131,11 @@ module Sources = struct
     in
     {Kind.Dict. c; cxx}
 end
+
+let all_possible_exts =
+  let exts = Kind.possible_exts ~dune_version:Stanza.latest_version in
+  header_ext :: exts C @ exts Cxx
+
+let c_cxx_or_header ~fn =
+  let ext = Filename.extension fn in
+  List.mem ~set:all_possible_exts ext

src/c.mli

@@ -1,5 +1,7 @@
 open Stdune
 
+val header_ext : string
+
 module Kind : sig
   type t =
     | C
@@ -65,3 +67,5 @@ module Sources : sig
 
   val split_by_kind : t -> t Kind.Dict.t
 end
+
+val c_cxx_or_header : fn:string -> bool

src/dep.ml

@@ -68,7 +68,7 @@ module T = struct
     match t with
     | Glob g -> pair string File_selector.encode ("glob", g)
     | Env e -> pair string string ("Env", e)
-    | File f -> pair string Path_dune_lang.encode ("File", f)
+    | File f -> pair string Dpath.encode ("File", f)
     | Alias a -> pair string Alias.encode ("Alias", a)
     | Universe -> string "Universe"
 end

src/dep_path.ml

@@ -10,8 +10,8 @@ module Entry = struct
     | Loc of Loc.t
 
   let pp = function
-    | Path p -> Pp.text (Utils.describe_path p)
-    | Alias p -> Pp.textf "alias %s" (Utils.describe_path p)
+    | Path p -> Pp.text (Dpath.describe_path p)
+    | Alias p -> Pp.textf "alias %s" (Dpath.describe_path p)
     | Library (path, lib_name) ->
       Pp.textf "library %S in %s"
         (Lib_name.to_string lib_name)

src/dpath.ml

@@ -0,0 +1,114 @@
+open Stdune
+
+type target_kind =
+  | Regular of string * Path.Source.t
+  | Alias   of string * Path.Source.t
+  | Install of string * Path.Source.t
+  | Other of Path.Build.t
+
+type path_kind =
+  | Source of Path.Source.t
+  | External of Path.External.t
+  | Build of target_kind
+
+let analyse_target (fn as original_fn) : target_kind =
+  match Path.Build.extract_first_component fn with
+  | Some (".aliases", sub) ->
+    (match Path.Local.split_first_component sub with
+     | None -> Other fn
+     | Some (ctx, fn) ->
+       if Path.Local.is_root fn then
+         Other original_fn
+       else
+         let basename =
+           match String.rsplit2 (Path.Local.basename fn) ~on:'-' with
+           | None -> assert false
+           | Some (name, digest) ->
+             assert (String.length digest = 32);
+             name
+         in
+         Alias (ctx,
+                Path.Source.relative
+                  (Path.Source.of_local (Path.Local.parent_exn fn))
+                  basename))
+  | Some ("install", sub) ->
+    (match Path.Local.split_first_component sub with
+     | None -> Other fn
+     | Some (ctx, fn) ->
+       Install (ctx, Path.Source.of_local fn))
+  | Some (ctx, sub) ->
+    Regular (ctx, Path.Source.of_local sub)
+  | None ->
+    Other fn
+
+let describe_target fn =
+  let ctx_suffix = function
+    | "default" -> ""
+    | ctx -> sprintf " (context %s)" ctx
+  in
+  match analyse_target fn with
+  | Alias (ctx, p) ->
+    sprintf "alias %s%s" (Path.Source.to_string_maybe_quoted p) (ctx_suffix ctx)
+  | Install (ctx, p) ->
+    sprintf "install %s%s" (Path.Source.to_string_maybe_quoted p) (ctx_suffix ctx)
+  | Regular (ctx, fn) ->
+    sprintf "%s%s" (Path.Source.to_string_maybe_quoted fn) (ctx_suffix ctx)
+  | Other fn ->
+    Path.Build.to_string_maybe_quoted fn
+
+let describe_path (p : Path.t) =
+  match p with
+  | External _ | In_source_tree _ ->
+    Path.to_string_maybe_quoted p
+  | In_build_dir p -> describe_target p
+
+let analyse_path (fn : Path.t) = match fn with
+  | In_source_tree src -> Source src
+  | External e -> External e
+  | In_build_dir build -> Build (analyse_target build)
+
+type t = Path.t
+
+let encode p =
+  let make constr arg =
+    Dune_lang.List [
+      Dune_lang.atom constr
+    ; Dune_lang.atom_or_quoted_string arg
+    ]
+  in
+  let open Path in
+  match p with
+  | In_build_dir p ->
+    make "In_build_dir" (Path.Build.to_string p)
+  | In_source_tree p ->
+    make "In_source_tree" (Path.Source.to_string p)
+  | External p ->
+    make "External" (Path.External.to_string p)
+
+let decode =
+  let open Dune_lang.Decoder in
+  let external_ =
+    plain_string (fun ~loc t ->
+      if Filename.is_relative t then
+        Dune_lang.Decoder.of_sexp_errorf loc "Absolute path expected"
+      else
+        Path.parse_string_exn ~loc t
+    )
+  in
+  sum
+    [ "In_build_dir"  , string    >>| Path.(relative build_dir)
+    ; "In_source_tree", string    >>| Path.(relative root)
+    ; "External"      , external_
+    ]
+
+module Local = struct
+  let encode ~dir:from p =
+    let open Dune_lang.Encoder in
+    string (Path.reach ~from p)
+
+  let decode ~dir =
+    let open Dune_lang.Decoder in
+    let+ (error_loc, path) = located string
+    in
+    Path.relative ~error_loc dir path
+end

src/dpath.mli

@@ -0,0 +1,28 @@
+open Stdune
+
+type target_kind =
+  | Regular of string (* build context *) * Path.Source.t
+  | Alias   of string (* build context *) * Path.Source.t
+  | Install of string (* build context *) * Path.Source.t
+  | Other of Path.Build.t
+
+type path_kind =
+  | Source of Path.Source.t
+  | External of Path.External.t
+  | Build of target_kind
+
+(** Return the name of an alias from its stamp file *)
+val analyse_target : Path.Build.t -> target_kind
+val analyse_path : Path.t -> path_kind
+
+(** Nice description of a target *)
+val describe_target : Path.Build.t -> string
+val describe_path : Path.t -> string
+
+include Dune_lang.Conv with type t = Path.t
+
+module Local : sig
+  val encode : dir:Path.t -> Path.t Dune_lang.Encoder.t
+
+  val decode : dir:Path.t -> Path.t Dune_lang.Decoder.t
+end

src/dune_package.ml

@@ -92,7 +92,7 @@ module Lib = struct
         } =
     let open Dune_lang.Encoder in
     let no_loc f (_loc, x) = f x in
-    let path = Path_dune_lang.Local.encode ~dir:package_root in
+    let path = Dpath.Local.encode ~dir:package_root in
     let paths name f = field_l name path f in
     let mode_paths name (xs : Path.t Mode.Dict.List.t) =
       field_l name sexp (Mode.Dict.List.encode path xs) in
@@ -131,7 +131,7 @@ module Lib = struct
 
   let decode ~base =
     let open Stanza.Decoder in
-    let path = Path_dune_lang.Local.decode ~dir:base in
+    let path = Dpath.Local.decode ~dir:base in
     let field_l s x = field ~default:[] s (list x) in
     let libs s = field_l s (located Lib_name.decode) in
     let paths s = field_l s path in

src/dune_package.mli

@@ -83,5 +83,5 @@ module Or_meta : sig
     -> (Syntax.Version.t * Dune_lang.t list) t
     -> Dune_lang.t list
 
-  val load : Path_dune_lang.t -> Sub_system_info.t t
+  val load : Dpath.t -> Sub_system_info.t t
 end

src/file_selector.ml

@@ -26,7 +26,7 @@ let pp fmt t = Dyn.pp fmt (to_dyn t)
 let encode { dir; predicate } =
   let open Dune_lang.Encoder in
   record
-    [ "dir", Path_dune_lang.encode dir
+    [ "dir", Dpath.encode dir
     ; "predicate", Predicate.encode predicate
     ]