matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Move error functions to Errors 

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
Rudi Grinberg 2018-08-23 11:51:43 +03:00
parent c66a181884
commit d9d7792cfb
34 changed files with 113 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/action.ml
View File

@ -441,7 +441,7 @@ module Unexpanded = struct
let check_mkdir loc path =
if not (Path.is_managed path) then
Dloc.fail loc
Errors.fail loc
"(mkdir ...) is not supported for paths outside of the workspace:\n\
\ %a\n"
(Dsexp.pp Dune)
@ -596,7 +596,7 @@ module Unexpanded = struct
Chdir (res, partial_expand t ~dir ~map_exe ~f)
| Right fn ->
let loc = String_with_vars.loc fn in
Dloc.fail loc
Errors.fail loc
"This directory cannot be evaluated statically.\n\
This is not allowed by dune"
end
@ -791,7 +791,7 @@ module Infer = struct
match fn with
| Left fn -> { acc with targets = Path.Set.add acc.targets fn }
| Right sw ->
Dloc.fail (String_with_vars.loc sw)
Errors.fail (String_with_vars.loc sw)
"Cannot determine this target statically."
let ( +< ) acc fn =
match fn with

2
src/blang.ml
View File

@ -35,7 +35,7 @@ let rec eval_bool t ~dir ~(f : 'a expander) =
begin match f.f ~mode:Single a with
| _, String "true" -> true
| _, String "false" -> false
| loc, _ -> Dloc.fail loc "This value must be either true or false"
| loc, _ -> Errors.fail loc "This value must be either true or false"
end
| And xs -> List.for_all ~f:(eval_bool ~f ~dir) xs
| Or xs -> List.exists ~f:(eval_bool ~f ~dir) xs

4
src/build_interpret.ml
View File

@ -220,7 +220,7 @@ module Rule = struct
match targets with
| [] ->
begin match loc with
| Some loc -> Dloc.fail loc "Rule has no targets specified"
| Some loc -> Errors.fail loc "Rule has no targets specified"
| None -> Exn.code_error "Build_interpret.Rule.make: no targets" []
end
| x :: l ->
@ -235,7 +235,7 @@ module Rule = struct
(List.map targets ~f:Target.path)
]
| Some loc ->
Dloc.fail loc
Errors.fail loc
"Rule has targets in different directories.\nTargets:\n%s"
(String.concat ~sep:"\n"
(List.map targets ~f:(fun t ->

10
src/build_system.ml
View File

@ -240,7 +240,7 @@ module Alias0 = struct
let of_user_written_path ~loc path =
if not (Path.is_in_build_dir path) then
Dloc.fail loc "Invalid alias!\n\
Errors.fail loc "Invalid alias!\n\
Tried to reference path outside build dir: %S"
(Path.to_string_maybe_quoted path);
{ dir = Path.parent_exn path
@ -305,13 +305,13 @@ module Alias0 = struct
match File_tree.find_dir file_tree src_dir with
| None ->
Build.fail { fail = fun () ->
Dloc.fail loc "Don't know about directory %s!"
Errors.fail loc "Don't know about directory %s!"
(Path.to_string_maybe_quoted src_dir) }
| Some dir ->
dep_rec_internal ~name:t.name ~dir ~ctx_dir
>>^ fun is_empty ->
if is_empty && not (is_standard t.name) then
Dloc.fail loc
Errors.fail loc
"This alias is empty.\n\
Alias %S is not defined in %s or any of its descendants."
t.name (Path.to_string_maybe_quoted src_dir)
@ -687,7 +687,7 @@ let remove_old_artifacts t ~dir ~subdirs_to_keep =
let no_rule_found =
let fail fn ~loc =
Dloc.fail_opt loc "No rule found for %s" (Utils.describe_target fn)
Errors.fail_opt loc "No rule found for %s" (Utils.describe_target fn)
in
fun t ~loc fn ->
match Utils.analyse_target fn with
@ -1068,7 +1068,7 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators =
let present_targets =
Path.Set.diff source_files_for_targtes absent_targets
in
Dloc.fail
Errors.fail
(rule_loc
~file_tree:t.file_tree
~loc:rule.loc

2
src/context.ml
View File

@ -270,7 +270,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
%s"
(Path.to_string ocamlc) msg
| Error (Makefile_config file, msg) ->
Dloc.fail (Loc.in_file (Path.to_string file)) "%s" msg
Errors.fail (Loc.in_file (Path.to_string file)) "%s" msg
in
Fiber.fork_and_join
findlib_path

18
src/dir_contents.ml
View File

@ -40,7 +40,7 @@ end = struct
match m with
| Ok m -> Some m
| Error s ->
Dloc.fail loc "Module %a doesn't exist." Module.Name.pp s)
Errors.fail loc "Module %a doesn't exist." Module.Name.pp s)
, modules
)
@ -136,7 +136,7 @@ end = struct
|> Option.value_exn
in
(* CR-soon jdimino for jdimino: report all errors *)
Dloc.fail loc
Errors.fail loc
"Module %a has an implementation, it cannot be listed here"
Module.Name.pp module_name
end
@ -379,7 +379,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
with
| Ok x -> x
| Error (name, _, (lib2, _)) ->
Dloc.fail lib2.buildable.loc
Errors.fail lib2.buildable.loc
"Library %S appears for the second time \
in this directory"
name
@ -391,7 +391,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
with
| Ok x -> x
| Error (name, _, (exes2, _)) ->
Dloc.fail exes2.buildable.loc
Errors.fail exes2.buildable.loc
"Executable %S appears for the second time \
in this directory"
name
@ -417,7 +417,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
Option.some_if (n = name) b.loc)
|> List.sort ~compare
in
Dloc.fail (Loc.in_file (List.hd locs).start.pos_fname)
Errors.fail (Loc.in_file (List.hd locs).start.pos_fname)
"Module %a is used in several stanzas:@\n\
@[<v>%a@]@\n\
@[%a@]"
@ -478,7 +478,7 @@ let build_mlds_map (d : Super_context.Dir_with_jbuild.t) ~files =
| Some s ->
s
| None ->
Dloc.fail loc "%s.mld doesn't exist in %s" s
Errors.fail loc "%s.mld doesn't exist in %s" s
(Path.to_string_maybe_quoted
(Path.drop_optional_build_context dir))
)
@ -514,7 +514,7 @@ module Dir_status = struct
match stanza with
| Include_subdirs (loc, x) ->
if Option.is_some acc then
Dloc.fail loc "The 'include_subdirs' stanza cannot appear \
Errors.fail loc "The 'include_subdirs' stanza cannot appear \
more than once";
Some x
| _ -> acc)
@ -524,7 +524,7 @@ module Dir_status = struct
match stanza with
| Library { buildable; _} | Executables { buildable; _ }
| Tests { exes = { buildable; _ }; _ } ->
Dloc.fail buildable.loc
Errors.fail buildable.loc
"This stanza is not allowed in a sub-directory of directory with \
(include_subdirs unqualified).\n\
Hint: add (include_subdirs no) to this file."
@ -664,7 +664,7 @@ let rec get sctx ~dir =
~f:(fun acc (dir, files) ->
let modules = modules_of_files ~dir ~files in
Module.Name.Map.union acc modules ~f:(fun name x y ->
Dloc.fail (Loc.in_file
Errors.fail (Loc.in_file
(Path.to_string
(match File_tree.Dir.dune_file ft_dir with
| None ->

23
src/dloc.ml
View File

@ -3,29 +3,6 @@ open Import
include Loc
let of_lexbuf lb =
{ Loc.start = Lexing.lexeme_start_p lb
; stop = Lexing.lexeme_end_p lb
}
let exnf t fmt =
Format.pp_open_box err_ppf 0;
Format.pp_print_as err_ppf 7 ""; (* "Error: " *)
kerrf (fmt^^ "@]") ~f:(fun s -> Exn.Loc_error (t, s))
let fail t fmt =
Format.pp_print_as err_ppf 7 ""; (* "Error: " *)
kerrf fmt ~f:(fun s ->
raise (Exn.Loc_error (t, s)))
let fail_lex lb fmt =
fail (of_lexbuf lb) fmt
let fail_opt t fmt =
match t with
| None -> die fmt
| Some t -> fail t fmt
let in_file = Loc.in_file
let file_line path n =

5
src/dloc.mli
View File

@ -5,11 +5,6 @@ type t = Loc.t =
; stop : Lexing.position
}
val exnf : t -> ('a, Format.formatter, unit, exn) format4 -> 'a
val fail : t -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
val fail_lex : Lexing.lexbuf -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
val fail_opt : t option -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
val in_file : string -> t
val none : t

16
src/dune_file.ml
View File

@ -79,9 +79,9 @@ end = struct
let validate (loc, res) ~wrapped =
match res, wrapped with
| Ok s, _ -> s
| Warn _, true -> Dloc.fail loc "%s" wrapped_message
| Warn _, true -> Errors.fail loc "%s" wrapped_message
| Warn s, false -> Dloc.warn loc "%s" wrapped_message; s
| Invalid, _ -> Dloc.fail loc "%s" invalid_message
| Invalid, _ -> Errors.fail loc "%s" invalid_message
let valid_char = function
| 'A'..'Z' | 'a'..'z' | '_' | '0'..'9' -> true
@ -216,7 +216,7 @@ module Pkg = struct
and (loc, name) = located Package.Name.dparse in
match resolve p name with
| Ok x -> x
| Error e -> Dloc.fail loc "%s" e
| Error e -> Errors.fail loc "%s" e
let field stanza =
map_validate
@ -1253,7 +1253,7 @@ module Executables = struct
let mode_to_string mode =
" - " ^ Dsexp.to_string ~syntax:Dune (Link_mode.dgen mode) in
let mode_strings = List.map ~f:mode_to_string Link_mode.installable_modes in
Dloc.fail
Errors.fail
buildable.loc
"No installable mode found for %s.\n\
One of the following modes is required:\n\
@ -1290,7 +1290,7 @@ module Executables = struct
let func =
match file_kind with
| Jbuild -> Dloc.warn
| Dune -> Dloc.fail
| Dune -> Errors.fail
in
func loc
"This field is useless without a (public_name%s ...) field."
@ -1857,7 +1857,7 @@ module Stanzas = struct
let dir = Path.parent_exn current_file in
let current_file = Path.relative dir fn in
if not (Path.exists current_file) then
Dloc.fail loc "File %s doesn't exist."
Errors.fail loc "File %s doesn't exist."
(Path.to_string_maybe_quoted current_file);
if List.exists include_stack ~f:(fun (_, f) -> Path.equal f current_file) then
raise (Include_loop (current_file, include_stack));
@ -1886,7 +1886,7 @@ module Stanzas = struct
(Path.to_string_maybe_quoted file)
loc.Loc.start.pos_lnum
in
Dloc.fail loc
Errors.fail loc
"Recursive inclusion of jbuild files detected:\n\
File %s is included from %s%s"
(Path.to_string_maybe_quoted file)
@ -1902,6 +1902,6 @@ module Stanzas = struct
~f:(function Dune_env.T e -> Some e | _ -> None)
with
| _ :: e :: _ ->
Dloc.fail e.loc "The 'env' stanza cannot appear more than once"
Errors.fail e.loc "The 'env' stanza cannot appear more than once"
| _ -> stanzas
end

2
src/dune_lexer.mll
View File

@ -12,7 +12,7 @@ let make_loc lexbuf : Loc.t =
let invalid_lang_line start lexbuf =
lexbuf.Lexing.lex_start_p <- start;
Dloc.fail_lex lexbuf
Errors.fail_lex lexbuf
"Invalid first line, expected: (lang <lang> <version>)"
}

6
src/dune_project.ml
View File

@ -225,7 +225,7 @@ module Extension = struct
let instantiate ~loc ~parse_args (name_loc, name) (ver_loc, ver) =
match Hashtbl.find extensions name with
| None ->
Dloc.fail name_loc "Unknown extension %S.%s" name
Errors.fail name_loc "Unknown extension %S.%s" name
(hint name (Hashtbl.keys extensions))
| Some t ->
Syntax.check_supported t.syntax (ver_loc, ver);
@ -331,7 +331,7 @@ let default_name ~dir ~packages =
match Name.named name with
| Some x -> x
| None ->
Dloc.fail (Loc.in_file (Path.to_string (Package.opam_file pkg)))
Errors.fail (Loc.in_file (Path.to_string (Package.opam_file pkg)))
"%S is not a valid opam package name."
name
@ -362,7 +362,7 @@ let parse ~dir ~lang ~packages ~file =
(Syntax.name e.extension.syntax, e.loc)))
with
| Error (name, _, loc) ->
Dloc.fail loc "Extension %S specified for the second time." name
Errors.fail loc "Extension %S specified for the second time." name
| Ok map ->
let project_file : Project_file.t = { file; exists = true } in
let extensions =

18
src/errors.ml
View File

@ -15,3 +15,21 @@ let kerrf fmt ~f =
let die fmt =
kerrf fmt ~f:(fun s -> raise (Exn.Fatal_error s))
let exnf t fmt =
Format.pp_open_box err_ppf 0;
Format.pp_print_as err_ppf 7 ""; (* "Error: " *)
kerrf (fmt^^ "@]") ~f:(fun s -> Exn.Loc_error (t, s))
let fail t fmt =
Format.pp_print_as err_ppf 7 ""; (* "Error: " *)
kerrf fmt ~f:(fun s ->
raise (Exn.Loc_error (t, s)))
let fail_lex lb fmt =
fail (Loc.of_lexbuf lb) fmt
let fail_opt t fmt =
match t with
| None -> die fmt
| Some t -> fail t fmt

6
src/errors.mli
View File

@ -1,3 +1,4 @@
open Stdune
(** Dealing with errors *)
(* CR-soon diml: stop including this in [Import] *)
@ -21,3 +22,8 @@ val kerrf
: ('a, Format.formatter, unit, 'b) format4
-> f:(string -> 'b)
-> 'a
val exnf : Loc.t -> ('a, Format.formatter, unit, exn) format4 -> 'a
val fail : Loc.t -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
val fail_lex : Lexing.lexbuf -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
val fail_opt : Loc.t option -> ('a, Format.formatter, unit, 'b ) format4 -> 'a

6
src/gen_rules.ml
View File

@ -62,11 +62,11 @@ module Gen(P : Install_rules.Params) = struct
match Module.Name.Map.find modules mod_name with
| Some m ->
if not (Module.has_impl m) then
Dloc.fail loc "Module %a has no implementation."
Errors.fail loc "Module %a has no implementation."
Module.Name.pp mod_name
else
{ Exe.Program.name; main_module_name = mod_name }
| None -> Dloc.fail loc "Module %a doesn't exist."
| None -> Errors.fail loc "Module %a doesn't exist."
Module.Name.pp mod_name)
in
@ -296,7 +296,7 @@ module Gen(P : Install_rules.Params) = struct
SC.add_rule sctx
(Build.fail ~targets
{ fail = fun () ->
Dloc.fail m.loc
Errors.fail m.loc
"I can't determine what library/executable the files \
produced by this stanza are part of."
})

2
src/inline_tests.ml
View File

@ -75,7 +75,7 @@ module Backend = struct
resolve x >>= fun lib ->
match get ~loc lib with
| None ->
Error (Dloc.exnf loc "%S is not an %s" name
Error (Errors.exnf loc "%S is not an %s" name
(desc ~plural:false))
| Some t -> Ok t))
}

2
src/install.ml
View File

@ -272,7 +272,7 @@ let load_install_file path =
; pos_cnum = col
}
in
Dloc.fail { start = pos; stop = pos } fmt
Errors.fail { start = pos; stop = pos } fmt
in
List.concat_map file.file_contents ~f:(function
| Variable (pos, section, files) -> begin

6
src/installed_dune_file.ml
View File

@ -17,7 +17,7 @@ let parse_sub_systems ~parsing_context sexps =
|> (function
| Ok x -> x
| Error (name, _, (loc, _, _)) ->
Dloc.fail loc "%S present twice" (Sub_system_name.to_string name))
Errors.fail loc "%S present twice" (Sub_system_name.to_string name))
|> Sub_system_name.Map.mapi ~f:(fun name (_, version, data) ->
let (module M) = Dune_file.Sub_system_info.get name in
Syntax.check_supported M.syntax version;
@ -73,10 +73,10 @@ let load fname =
| 2, Atom (A "1") -> state := 3; lexer := Dsexp.Lexer.jbuild_token
| 2, Atom (A "2") -> state := 3; lexer := Dsexp.Lexer.token
| 2, Atom (A version) ->
Dloc.fail (Loc.of_lexbuf lexbuf) "Unsupported version %S" version
Errors.fail (Loc.of_lexbuf lexbuf) "Unsupported version %S" version
| 3, _ -> ()
| _ ->
Dloc.fail (Loc.of_lexbuf lexbuf)
Errors.fail (Loc.of_lexbuf lexbuf)
"This <lib>.dune file looks invalid, it should \
contain a S-expression of the form (dune x.y ..)"
);

4
src/jbuild_load.ml
View File

@ -74,7 +74,7 @@ module Jbuilds = struct
(match (kind : File_tree.Dune_file.Kind.t) with
| Jbuild -> ()
| Dune ->
Dloc.fail loc
Errors.fail loc
"#require is no longer supported in dune files.\n\
You can use the following function instead of \
Unix.open_process_in:\n\
@ -85,7 +85,7 @@ module Jbuilds = struct
| [] -> acc
| ["unix"] -> Unix
| _ ->
Dloc.fail loc
Errors.fail loc
"Using libraries other that \"unix\" is not supported.\n\
See the manual for details.";
in

4
src/lib.ml
View File

@ -320,7 +320,7 @@ exception Error of Error.t
let not_available ~loc reason fmt =
Errors.kerrf fmt ~f:(fun s ->
Dloc.fail loc "%s %a" s
Errors.fail loc "%s %a" s
Error.Library_not_available.Reason.pp reason)
(* +-----------------------------------------------------------------+
@ -492,7 +492,7 @@ module Sub_system = struct
| M.Info.T info ->
let get ~loc lib' =
if lib.unique_id = lib'.unique_id then
Dloc.fail loc "Library %S depends on itself" lib.name
Errors.fail loc "Library %S depends on itself" lib.name
else
M.get lib'
in

2
src/lib_rules.ml
View File

@ -227,7 +227,7 @@ module Gen (P : Install_rules.Params) = struct
if not (match Path.parent p with
| None -> false
| Some p -> Path.Set.mem all_dirs p) then
Dloc.fail loc
Errors.fail loc
"File %a is not part of the current directory group. \
This is not allowed."
Path.pp (Path.drop_optional_build_context p)

2
src/meta.ml
View File

@ -25,7 +25,7 @@ and predicate =
| Neg of string
module Parse = struct
let error = Dloc.fail_lex
let error = Errors.fail_lex
let next = Meta_lexer.token

4
src/meta_lexer.mll
View File

@ -29,7 +29,7 @@ rule token = parse
| '=' { Equal }
| "+=" { Plus_equal }
| eof { Eof }
| _ { Dloc.fail_lex lexbuf "invalid character" }
| _ { Errors.fail_lex lexbuf "invalid character" }
and string buf = parse
| '"'
@ -44,4 +44,4 @@ and string buf = parse
{ Buffer.add_char buf c;
string buf lexbuf }
| eof
{ Dloc.fail_lex lexbuf "unterminated string" }
{ Errors.fail_lex lexbuf "unterminated string" }

4
src/opam_file.ml
View File

@ -10,9 +10,9 @@ let load fn =
OpamBaseParser.main OpamLexer.token lb (Path.to_string fn)
with
| OpamLexer.Error msg ->
Dloc.fail_lex lb "%s" msg
Errors.fail_lex lb "%s" msg
| Parsing.Parse_error ->
Dloc.fail_lex lb "Parse error")
Errors.fail_lex lb "Parse error")
let get_field t name =
List.find_map t.file_contents

12
src/ordered_set_lang.ml
View File

@ -35,7 +35,7 @@ module Parse = struct
let open Stanza.Of_sexp in
let rec one (kind : Stanza.File_kind.t) =
peek_exn >>= function
| Atom (loc, A "\\") -> Dloc.fail loc "unexpected \\"
| Atom (loc, A "\\") -> Errors.fail loc "unexpected \\"
| (Atom (_, A "") | Quoted_string (_, _)) | Template _ ->
elt
| Atom (loc, A s) -> begin
@ -43,10 +43,10 @@ module Parse = struct
| ":standard" ->
junk >>> return Standard
| ":include" ->
Dloc.fail loc
Errors.fail loc
"Invalid use of :include, should be: (:include <filename>)"
| _ when s.[0] = ':' ->
Dloc.fail loc "undefined symbol %s" s
Errors.fail loc "undefined symbol %s" s
| _ ->
elt
end
@ -54,7 +54,7 @@ module Parse = struct
match s, kind with
| ":include", _ -> inc
| s, Dune when s <> "" && s.[0] <> '-' && s.[0] <> ':' ->
Dloc.fail loc
Errors.fail loc
"This atom must be quoted because it is the first element \
of a list and doesn't start with - or :"
| _ -> enter (many [] kind)
@ -86,7 +86,7 @@ module Parse = struct
generic ~elt ~inc:(
enter
(loc >>= fun loc ->
Dloc.fail loc "(:include ...) is not allowed here"))
Errors.fail loc "(:include ...) is not allowed here"))
end
@ -350,7 +350,7 @@ module Unexpanded = struct
match f fn with
| [x] -> Value.to_path ~dir x
| _ ->
Dloc.fail (String_with_vars.loc fn)
Errors.fail (String_with_vars.loc fn)
"An unquoted templated expanded to more than one value. \
A file path is expected in this position."
in

10
src/preprocessing.ml
View File

@ -92,7 +92,7 @@ module Driver = struct
resolve x >>= fun lib ->
match get ~loc lib with
| None ->
Error (Dloc.exnf loc "%S is not a %s" name
Error (Errors.exnf loc "%S is not a %s" name
(desc ~plural:false))
| Some t -> Ok t))
}
@ -120,9 +120,9 @@ module Driver = struct
let make_error loc msg =
match loc with
| User_file (loc, _) -> Error (Dloc.exnf loc "%a" Fmt.text msg)
| User_file (loc, _) -> Error (Errors.exnf loc "%a" Fmt.text msg)
| Dot_ppx (path, pps) ->
Error (Dloc.exnf (Loc.in_file (Path.to_string path)) "%a" Fmt.text
Error (Errors.exnf (Loc.in_file (Path.to_string path)) "%a" Fmt.text
(sprintf
"Failed to create on-demand ppx rewriter for %s; %s"
(String.enumerate_and (List.map pps ~f:Pp.to_string))
@ -437,7 +437,7 @@ let setup_reason_rules sctx (m : Module.t) =
| ".re" -> ".re.ml"
| ".rei" -> ".re.mli"
| _ ->
Dloc.fail
Errors.fail
(Loc.in_file
(Path.to_string (Path.drop_build_context_exn f.path)))
"Unknown file extension for reason source file: %S"
@ -491,7 +491,7 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind =
~scope)))
| Pps { loc; pps; flags; staged } ->
if staged then
Dloc.fail loc
Errors.fail loc
"Staged ppx rewriters cannot be used as linters.";
let args : _ Arg_spec.t =
S [ As flags

6
src/simple_rules.ml
View File

@ -41,7 +41,7 @@ let copy_files sctx ~dir ~scope ~src_dir (def: Copy_files.t) =
ensures that [sources_and_targets_known_so_far] returns the
right answer for sub-directories only. *)
if not (Path.is_descendant glob_in_src ~of_:src_dir) then
Dloc.fail loc "%s is not a sub-directory of %s"
Errors.fail loc "%s is not a sub-directory of %s"
(Path.to_string_maybe_quoted glob_in_src) (Path.to_string_maybe_quoted src_dir);
let glob = Path.basename glob_in_src in
let src_in_src = Path.parent_exn glob_in_src in
@ -50,11 +50,11 @@ let copy_files sctx ~dir ~scope ~src_dir (def: Copy_files.t) =
| Ok re ->
Re.compile re
| Error (_pos, msg) ->
Dloc.fail (String_with_vars.loc def.glob) "invalid glob: %s" msg
Errors.fail (String_with_vars.loc def.glob) "invalid glob: %s" msg
in
let file_tree = Super_context.file_tree sctx in
if not (File_tree.dir_exists file_tree src_in_src) then
Dloc.fail
Errors.fail
loc
"cannot find directory: %a"
Path.pp src_in_src;

6
src/string_with_vars.ml
View File

@ -183,7 +183,7 @@ module Partial = struct
end
let invalid_multivalue (v : var) x =
Dloc.fail v.loc "Variable %s expands to %d values, \
Errors.fail v.loc "Variable %s expands to %d values, \
however a single value is expected here. \
Please quote this atom."
(string_of_var v) (List.length x)
@ -272,9 +272,9 @@ let expand t ~mode ~dir ~f =
begin match var.syntax with
| Percent ->
if Var.is_macro var then
Dloc.fail var.loc "Unknown macro %s" (Var.describe var)
Errors.fail var.loc "Unknown macro %s" (Var.describe var)
else
Dloc.fail var.loc "Unknown variable %S" (Var.name var)
Errors.fail var.loc "Unknown variable %S" (Var.name var)
| Dollar_brace
| Dollar_paren -> Some [Value.String (string_of_var var)]
end

6
src/sub_system.ml
View File

@ -40,7 +40,7 @@ module Register_backend(M : Backend) = struct
Lib.DB.resolve db (loc, name) >>= fun lib ->
match get lib with
| None ->
Error (Dloc.exnf loc "%S is not %s %s" name M.desc_article
Error (Errors.exnf loc "%S is not %s %s" name M.desc_article
(M.desc ~plural:false))
| Some t -> Ok t
@ -53,7 +53,7 @@ module Register_backend(M : Backend) = struct
let to_exn t ~loc =
match t with
| Too_many_backends backends ->
Dloc.exnf loc
Errors.exnf loc
"Too many independent %s found:\n%s"
(M.desc ~plural:true)
(String.concat ~sep:"\n"
@ -63,7 +63,7 @@ module Register_backend(M : Backend) = struct
(Lib.name lib)
(Path.to_string_maybe_quoted (Lib.src_dir lib)))))
| No_backend_found ->
Dloc.exnf loc "No %s found." (M.desc ~plural:false)
Errors.exnf loc "No %s found." (M.desc ~plural:false)
| Other exn ->
exn

16
src/super_context.ml
View File

@ -131,7 +131,7 @@ let expand_ocaml_config t pform name =
match String.Map.find t.ocaml_config name with
| Some x -> x
| None ->
Dloc.fail (String_with_vars.Var.loc pform)
Errors.fail (String_with_vars.Var.loc pform)
"Unknown ocaml configuration variable %S"
name
@ -145,7 +145,7 @@ let expand_vars t ~mode ~scope ~dir ?(bindings=Pform.Map.empty) s =
| Macro (Ocaml_config, s) -> expand_ocaml_config t pform s
| Var Project_root -> [Value.Dir (Scope.root scope)]
| _ ->
Dloc.fail (String_with_vars.Var.loc pform)
Errors.fail (String_with_vars.Var.loc pform)
"%s isn't allowed in this position"
(String_with_vars.Var.describe pform)))
@ -260,7 +260,7 @@ end = struct
let parse_lib_file ~loc s =
match String.lsplit2 s ~on:':' with
| None ->
Dloc.fail loc "invalid %%{lib:...} form: %s" s
Errors.fail loc "invalid %%{lib:...} form: %s" s
| Some x -> x
open Build.O
@ -279,10 +279,10 @@ end = struct
| Var Targets ->
begin match targets_written_by_user with
| Infer ->
Dloc.fail loc "You cannot use %s with inferred rules."
Errors.fail loc "You cannot use %s with inferred rules."
(String_with_vars.Var.describe pform)
| Alias ->
Dloc.fail loc "You cannot use %s in aliases."
Errors.fail loc "You cannot use %s in aliases."
(String_with_vars.Var.describe pform)
| Static l ->
Some (Value.L.dirs l) (* XXX hack to signal no dep *)
@ -348,7 +348,7 @@ end = struct
Resolved_forms.add_ddep acc ~key x
| None ->
Resolved_forms.add_fail acc { fail = fun () ->
Dloc.fail loc
Errors.fail loc
"Package %S doesn't exist in the current project." s
}
end
@ -754,7 +754,7 @@ module Deps = struct
Build.paths_glob ~loc ~dir (Re.compile re)
>>^ Path.Set.to_list
| Error (_pos, msg) ->
Dloc.fail (String_with_vars.loc s) "invalid glob: %s" msg
Errors.fail (String_with_vars.loc s) "invalid glob: %s" msg
end
| Source_tree s ->
let path = expand_vars_path t ~scope ~dir s in
@ -900,7 +900,7 @@ module Action = struct
let targets = Path.Set.to_list targets in
List.iter targets ~f:(fun target ->
if Path.parent_exn target <> targets_dir then
Dloc.fail loc
Errors.fail loc
"This action has targets in a different directory than the current \
one, this is not allowed by dune at the moment:\n%s"
(List.map targets ~f:(fun target ->

10
src/syntax.ml
View File

@ -28,7 +28,7 @@ module Version = struct
try
Scanf.sscanf s "%u.%u" (fun a b -> (a, b))
with _ ->
Dloc.fail loc "Atom of the form NNN.NNN expected"
Errors.fail loc "Atom of the form NNN.NNN expected"
end
| sexp ->
of_sexp_error (Dsexp.Ast.loc sexp) "Atom expected"
@ -79,15 +79,15 @@ type t =
module Error = struct
let since loc t ver ~what =
Dloc.fail loc "%s is only available since version %s of %s"
Errors.fail loc "%s is only available since version %s of %s"
what (Version.to_string ver) t.desc
let renamed_in loc t ver ~what ~to_ =
Dloc.fail loc "%s was renamed to '%s' in the %s version of %s"
Errors.fail loc "%s was renamed to '%s' in the %s version of %s"
what to_ (Version.to_string ver) t.desc
let deleted_in loc t ?repl ver ~what =
Dloc.fail loc "%s was deleted in version %s of %s%s"
Errors.fail loc "%s was deleted in version %s of %s%s"
what (Version.to_string ver) t.desc
(match repl with
| None -> ""
@ -106,7 +106,7 @@ let name t = t.name
let check_supported t (loc, ver) =
if not (Supported_versions.is_supported t.supported_versions ver) then
Dloc.fail loc "Version %s of %s is not supported.\n\
Errors.fail loc "Version %s of %s is not supported.\n\
Supported versions:\n\
%s"
(Version.to_string ver) t.name

2
src/utils.ml
View File

@ -115,7 +115,7 @@ let executable_object_directory ~dir name =
Path.relative dir ("." ^ name ^ ".eobjs")
let program_not_found ?context ?hint ~loc prog =
Dloc.fail_opt loc
Errors.fail_opt loc
"@{<error>Error@}: Program %s not found in the tree or in PATH%s%a"
(String.maybe_quoted prog)
(match context with

2
src/versioned_file.ml
View File

@ -58,7 +58,7 @@ module Make(Data : sig type t end) = struct
(Atom (ver_loc, Dsexp.Atom.of_string ver)) in
match Hashtbl.find langs name with
| None ->
Dloc.fail name_loc "Unknown language %S.%s" name
Errors.fail name_loc "Unknown language %S.%s" name
(hint name (Hashtbl.keys langs))
| Some t ->
Syntax.check_supported t.syntax (ver_loc, ver);

2
src/watermarks.ml
View File

@ -131,7 +131,7 @@ let subst_string s path ~map =
loop (i + 1) acc
| Some (Error msg) ->
let loc = loc_of_offset ~ofs:start ~len:(i + 1 - start) in
Dloc.fail loc "%s" msg
Errors.fail loc "%s" msg
end
| _ -> loop (i + 1) acc
in

4
src/workspace.ml
View File

@ -171,13 +171,13 @@ let t ?x ?profile:cmdline_profile () =
List.fold_left contexts ~init:None ~f:(fun acc ctx ->
let name = Context.name ctx in
if String.Set.mem !defined_names name then
Dloc.fail (Context.loc ctx)
Errors.fail (Context.loc ctx)
"second definition of build context %S" name;
defined_names := String.Set.union !defined_names
(String.Set.of_list (Context.all_names ctx));
match ctx, acc with
| Opam { merlin = true; _ }, Some _ ->
Dloc.fail (Context.loc ctx)
Errors.fail (Context.loc ctx)
"you can only have one context for merlin"
| Opam { merlin = true; _ }, None ->
Some name