Suffix all alias files, to avoid clashes with doc
This commit is contained in:
parent
87c958f2e0
commit
dd79bdd8d1
11
src/alias.ml
11
src/alias.ml
|
@ -17,13 +17,15 @@ type t =
|
||||||
|
|
||||||
let aliases_path = Path.(relative root) "_build/.aliases"
|
let aliases_path = Path.(relative root) "_build/.aliases"
|
||||||
|
|
||||||
|
let suffix = "-" ^ String.make 32 '0'
|
||||||
|
|
||||||
let of_path path =
|
let of_path path =
|
||||||
if not (Path.is_local path) then
|
if not (Path.is_local path) then
|
||||||
die "Aliases are only supported for local paths!\n\
|
die "Aliases are only supported for local paths!\n\
|
||||||
Tried to reference alias %S"
|
Tried to reference alias %S"
|
||||||
(Path.to_string path);
|
(Path.to_string path);
|
||||||
{ name = Name.make path
|
{ name = Name.make path
|
||||||
; file = Path.append aliases_path path
|
; file = Path.extend_basename (Path.append aliases_path path) ~suffix
|
||||||
}
|
}
|
||||||
|
|
||||||
let make name ~dir = of_path (Path.relative dir name)
|
let make name ~dir = of_path (Path.relative dir name)
|
||||||
|
@ -32,6 +34,13 @@ let dep t = Build.path t.file
|
||||||
|
|
||||||
let file t = t.file
|
let file t = t.file
|
||||||
|
|
||||||
|
let file_with_digest_suffix t ~digest =
|
||||||
|
let dir = Path.parent t.file in
|
||||||
|
let base = Path.basename t.file in
|
||||||
|
let len = String.length base in
|
||||||
|
Path.relative dir
|
||||||
|
(String.sub base ~pos:0 ~len:(len - 32) ^ Digest.to_hex digest)
|
||||||
|
|
||||||
let default = make "DEFAULT"
|
let default = make "DEFAULT"
|
||||||
let runtest = make "runtest"
|
let runtest = make "runtest"
|
||||||
let install = make "install"
|
let install = make "install"
|
||||||
|
|
|
@ -11,6 +11,8 @@ val lib_cm_all : dir:Path.t -> string -> Cm_kind.t -> t
|
||||||
val dep : t -> ('a, 'a) Build.t
|
val dep : t -> ('a, 'a) Build.t
|
||||||
val file : t -> Path.t
|
val file : t -> Path.t
|
||||||
|
|
||||||
|
val file_with_digest_suffix : t -> digest:Digest.t -> Path.t
|
||||||
|
|
||||||
module Store : sig
|
module Store : sig
|
||||||
type t
|
type t
|
||||||
val create : unit -> t
|
val create : unit -> t
|
||||||
|
|
109
src/future.ml
109
src/future.ml
|
@ -335,65 +335,66 @@ module Scheduler = struct
|
||||||
| File fn | Opened_file { filename = fn; _ } -> sprintf "%s 2> %s" s fn
|
| File fn | Opened_file { filename = fn; _ } -> sprintf "%s 2> %s" s fn
|
||||||
|
|
||||||
let pp_purpose ppf = function
|
let pp_purpose ppf = function
|
||||||
| Internal_job ->
|
| Internal_job ->
|
||||||
Format.fprintf ppf "(internal)"
|
Format.fprintf ppf "(internal)"
|
||||||
| Build_job targets ->
|
| Build_job targets ->
|
||||||
let rec split_paths targets_acc ctxs_acc = function
|
let rec split_paths targets_acc ctxs_acc = function
|
||||||
| [] -> List.rev targets_acc, String_set.(elements (of_list ctxs_acc))
|
| [] -> List.rev targets_acc, String_set.(elements (of_list ctxs_acc))
|
||||||
| path :: rest ->
|
| path :: rest ->
|
||||||
match Path.extract_build_context path with
|
match Path.extract_build_context path with
|
||||||
| None ->
|
| None ->
|
||||||
split_paths (Path.to_string path :: targets_acc) ctxs_acc rest
|
split_paths (Path.to_string path :: targets_acc) ctxs_acc rest
|
||||||
| Some ("default", filename) ->
|
| Some ("default", filename) ->
|
||||||
split_paths (Path.to_string filename :: targets_acc) ctxs_acc rest
|
split_paths (Path.to_string filename :: targets_acc) ctxs_acc rest
|
||||||
| Some (".aliases", filename) ->
|
| Some (".aliases", filename) ->
|
||||||
let ctxs_acc, filename = match Path.extract_build_context filename with
|
let ctxs_acc, filename =
|
||||||
| None -> ctxs_acc, Path.to_string filename
|
match Path.extract_build_context filename with
|
||||||
| Some (ctx, fn) ->
|
| None -> ctxs_acc, Path.to_string filename
|
||||||
let strip_digest fn =
|
| Some (ctx, fn) ->
|
||||||
let fn = Path.to_string fn in
|
let strip_digest fn =
|
||||||
match String.rsplit2 fn ~on:'-' with
|
let fn = Path.to_string fn in
|
||||||
| None -> fn
|
match String.rsplit2 fn ~on:'-' with
|
||||||
| Some (name, digest) ->
|
| None -> assert false
|
||||||
match Digest.from_hex digest with
|
| Some (name, digest) ->
|
||||||
| _ -> name
|
assert (String.length digest = 32);
|
||||||
| exception (Invalid_argument _) -> fn in
|
name
|
||||||
let ctxs_acc =
|
in
|
||||||
if ctx = "default" then ctxs_acc else ctx :: ctxs_acc in
|
let ctxs_acc =
|
||||||
ctxs_acc, strip_digest fn in
|
if ctx = "default" then ctxs_acc else ctx :: ctxs_acc in
|
||||||
split_paths (("alias " ^ filename) :: targets_acc) ctxs_acc rest
|
ctxs_acc, strip_digest fn in
|
||||||
|
split_paths (("alias " ^ filename) :: targets_acc) ctxs_acc rest
|
||||||
| Some (ctx, filename) ->
|
| Some (ctx, filename) ->
|
||||||
split_paths (Path.to_string filename :: targets_acc) (ctx :: ctxs_acc) rest in
|
split_paths (Path.to_string filename :: targets_acc) (ctx :: ctxs_acc) rest in
|
||||||
let target_names, contexts = split_paths [] [] targets in
|
let target_names, contexts = split_paths [] [] targets in
|
||||||
let target_names_grouped_by_prefix =
|
let target_names_grouped_by_prefix =
|
||||||
List.map target_names ~f:Filename.split_extension_after_dot
|
List.map target_names ~f:Filename.split_extension_after_dot
|
||||||
|> String_map.of_alist_multi
|
|> String_map.of_alist_multi
|
||||||
|> String_map.bindings
|
|> String_map.bindings
|
||||||
in
|
in
|
||||||
let pp_comma ppf () = Format.fprintf ppf "," in
|
let pp_comma ppf () = Format.fprintf ppf "," in
|
||||||
let pp_group ppf (prefix, suffixes) =
|
let pp_group ppf (prefix, suffixes) =
|
||||||
match suffixes with
|
match suffixes with
|
||||||
| [] -> assert false
|
| [] -> assert false
|
||||||
| [suffix] -> Format.fprintf ppf "%s%s" prefix suffix
|
| [suffix] -> Format.fprintf ppf "%s%s" prefix suffix
|
||||||
| _ ->
|
| _ ->
|
||||||
Format.fprintf ppf "%s{%a}"
|
Format.fprintf ppf "%s{%a}"
|
||||||
prefix
|
prefix
|
||||||
(Format.pp_print_list ~pp_sep:pp_comma Format.pp_print_string)
|
(Format.pp_print_list ~pp_sep:pp_comma Format.pp_print_string)
|
||||||
suffixes
|
suffixes
|
||||||
in
|
in
|
||||||
let pp_contexts ppf = function
|
let pp_contexts ppf = function
|
||||||
| [] -> ()
|
| [] -> ()
|
||||||
| ctxs ->
|
| ctxs ->
|
||||||
Format.fprintf ppf " @{<details>[%a]@}"
|
Format.fprintf ppf " @{<details>[%a]@}"
|
||||||
(Format.pp_print_list ~pp_sep:pp_comma
|
(Format.pp_print_list ~pp_sep:pp_comma
|
||||||
(fun ppf s -> Format.fprintf ppf "%s" s))
|
(fun ppf s -> Format.fprintf ppf "%s" s))
|
||||||
ctxs
|
ctxs
|
||||||
in
|
in
|
||||||
Format.fprintf ppf "%a%a"
|
Format.fprintf ppf "%a%a"
|
||||||
(Format.pp_print_list ~pp_sep:pp_comma pp_group)
|
(Format.pp_print_list ~pp_sep:pp_comma pp_group)
|
||||||
target_names_grouped_by_prefix
|
target_names_grouped_by_prefix
|
||||||
pp_contexts
|
pp_contexts
|
||||||
contexts;
|
contexts;
|
||||||
|
|
||||||
type running_job =
|
type running_job =
|
||||||
{ id : int
|
{ id : int
|
||||||
|
|
|
@ -489,9 +489,9 @@ module Gen(P : Params) = struct
|
||||||
Sexp.List [deps ; action]
|
Sexp.List [deps ; action]
|
||||||
|> Sexp.to_string
|
|> Sexp.to_string
|
||||||
|> Digest.string
|
|> Digest.string
|
||||||
|> Digest.to_hex in
|
in
|
||||||
let alias = Alias.make alias_conf.name ~dir in
|
let alias = Alias.make alias_conf.name ~dir in
|
||||||
let digest_path = Path.extend_basename (Alias.file alias) ~suffix:("-" ^ digest) in
|
let digest_path = Alias.file_with_digest_suffix alias ~digest in
|
||||||
Alias.add_deps (SC.aliases sctx) alias [digest_path];
|
Alias.add_deps (SC.aliases sctx) alias [digest_path];
|
||||||
let deps = SC.Deps.interpret sctx ~dir alias_conf.deps in
|
let deps = SC.Deps.interpret sctx ~dir alias_conf.deps in
|
||||||
SC.add_rule sctx
|
SC.add_rule sctx
|
||||||
|
|
Loading…
Reference in New Issue