Entirely eliminate Dloc
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
d9d7792cfb
commit
ca6e7c04bd
|
@ -83,11 +83,11 @@ let static_deps t ~all_targets ~file_tree =
|
|||
if Path.Set.is_empty result then begin
|
||||
match inspect_path file_tree dir with
|
||||
| None ->
|
||||
Dloc.warn loc "Directory %s doesn't exist."
|
||||
Errors.warn loc "Directory %s doesn't exist."
|
||||
(Path.to_string_maybe_quoted
|
||||
(Path.drop_optional_build_context dir))
|
||||
| Some Reg ->
|
||||
Dloc.warn loc "%s is not a directory."
|
||||
Errors.warn loc "%s is not a directory."
|
||||
(Path.to_string_maybe_quoted
|
||||
(Path.drop_optional_build_context dir))
|
||||
| Some Dir ->
|
||||
|
|
|
@ -565,7 +565,7 @@ let add_spec t fn spec ~copy_source =
|
|||
| Some (File_spec.T { rule; _ }) ->
|
||||
match copy_source, rule.mode with
|
||||
| true, (Standard | Not_a_rule_stanza) ->
|
||||
Dloc.warn (Internal_rule.loc rule ~dir:(Path.parent_exn fn)
|
||||
Errors.warn (Internal_rule.loc rule ~dir:(Path.parent_exn fn)
|
||||
~file_tree:t.file_tree)
|
||||
"File %s is both generated by a rule and present in the source tree.\n\
|
||||
As a result, the rule is currently ignored, however this will become an error \
|
||||
|
|
|
@ -101,7 +101,7 @@ end = struct
|
|||
if missing_intf_only <> [] then begin
|
||||
match Ordered_set_lang.loc buildable.modules_without_implementation with
|
||||
| None ->
|
||||
Dloc.warn buildable.loc
|
||||
Errors.warn buildable.loc
|
||||
"Some modules don't have an implementation.\
|
||||
\nYou need to add the following field to this stanza:\
|
||||
\n\
|
||||
|
@ -122,7 +122,7 @@ end = struct
|
|||
|> List.map ~f:(sprintf "- %s")
|
||||
|> String.concat ~sep:"\n"
|
||||
in
|
||||
Dloc.warn loc
|
||||
Errors.warn loc
|
||||
"The following modules must be listed here as they don't \
|
||||
have an implementation:\n\
|
||||
%s\n\
|
||||
|
@ -155,7 +155,7 @@ end = struct
|
|||
)
|
||||
in
|
||||
Module.Name.Map.iteri fake_modules ~f:(fun m loc ->
|
||||
Dloc.warn loc "Module %a is excluded but it doesn't exist."
|
||||
Errors.warn loc "Module %a is excluded but it doesn't exist."
|
||||
Module.Name.pp m
|
||||
);
|
||||
check_invalid_module_listing ~buildable:conf ~intf_only ~modules
|
||||
|
@ -442,7 +442,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
|
|||
List.sort ~compare
|
||||
(b.Buildable.loc :: List.map rest ~f:(fun b -> b.Buildable.loc))
|
||||
in
|
||||
Dloc.warn (Loc.in_file b.loc.start.pos_fname)
|
||||
Errors.warn (Loc.in_file b.loc.start.pos_fname)
|
||||
"Module %a is used in several stanzas:@\n\
|
||||
@[<v>%a@]@\n\
|
||||
@[%a@]@\n\
|
||||
|
|
65
src/dloc.ml
65
src/dloc.ml
|
@ -1,65 +0,0 @@
|
|||
open! Stdune
|
||||
open Import
|
||||
|
||||
include Loc
|
||||
|
||||
let in_file = Loc.in_file
|
||||
|
||||
let file_line path n =
|
||||
Io.with_file_in ~binary:false path
|
||||
~f:(fun ic ->
|
||||
for _ = 1 to n - 1 do
|
||||
ignore (input_line ic)
|
||||
done;
|
||||
input_line ic
|
||||
)
|
||||
|
||||
let file_lines path ~start ~stop =
|
||||
Io.with_file_in ~binary:true path
|
||||
~f:(fun ic ->
|
||||
let rec aux acc lnum =
|
||||
if lnum > stop then
|
||||
List.rev acc
|
||||
else if lnum < start then
|
||||
(ignore (input_line ic);
|
||||
aux acc (lnum + 1))
|
||||
else
|
||||
let line = input_line ic in
|
||||
aux ((string_of_int lnum, line) :: acc) (lnum + 1)
|
||||
in
|
||||
aux [] 1
|
||||
)
|
||||
|
||||
let print ppf loc =
|
||||
let { Loc.start; stop } = loc in
|
||||
let start_c = start.pos_cnum - start.pos_bol in
|
||||
let stop_c = stop.pos_cnum - start.pos_bol in
|
||||
let num_lines = stop.pos_lnum - start.pos_lnum in
|
||||
let pp_file_excerpt pp () =
|
||||
let whole_file = start_c = 0 && stop_c = 0 in
|
||||
if not whole_file then
|
||||
let path = Path.of_string start.pos_fname in
|
||||
if Path.exists path then
|
||||
let line = file_line path start.pos_lnum in
|
||||
if stop_c <= String.length line then
|
||||
let len = stop_c - start_c in
|
||||
Format.fprintf pp "%s\n%*s\n" line
|
||||
stop_c
|
||||
(String.make len '^')
|
||||
else if num_lines <= 10 then
|
||||
let lines = file_lines path ~start:start.pos_lnum ~stop:stop.pos_lnum in
|
||||
let last_lnum = Option.map ~f:fst (List.last lines) in
|
||||
let padding_width = Option.value_exn
|
||||
(Option.map ~f:String.length last_lnum) in
|
||||
List.iter ~f:(fun (lnum, l) ->
|
||||
Format.fprintf pp "%*s: %s\n" padding_width lnum l)
|
||||
lines
|
||||
in
|
||||
Format.fprintf ppf
|
||||
"@{<loc>File \"%s\", line %d, characters %d-%d:@}@\n%a"
|
||||
start.pos_fname start.pos_lnum start_c stop_c
|
||||
pp_file_excerpt ()
|
||||
|
||||
let warn t fmt =
|
||||
Errors.kerrf ~f:print_to_console
|
||||
("%a@{<warning>Warning@}: " ^^ fmt ^^ "@.") print t
|
16
src/dloc.mli
16
src/dloc.mli
|
@ -1,16 +0,0 @@
|
|||
open! Stdune
|
||||
|
||||
type t = Loc.t =
|
||||
{ start : Lexing.position
|
||||
; stop : Lexing.position
|
||||
}
|
||||
|
||||
val in_file : string -> t
|
||||
|
||||
val none : t
|
||||
|
||||
(** Prints "File ..., line ..., characters ...:\n" *)
|
||||
val print : Format.formatter -> t -> unit
|
||||
|
||||
(** Prints a warning *)
|
||||
val warn : t -> ('a, Format.formatter, unit) format -> 'a
|
|
@ -80,7 +80,7 @@ end = struct
|
|||
match res, wrapped with
|
||||
| Ok s, _ -> s
|
||||
| Warn _, true -> Errors.fail loc "%s" wrapped_message
|
||||
| Warn s, false -> Dloc.warn loc "%s" wrapped_message; s
|
||||
| Warn s, false -> Errors.warn loc "%s" wrapped_message; s
|
||||
| Invalid, _ -> Errors.fail loc "%s" invalid_message
|
||||
|
||||
let valid_char = function
|
||||
|
@ -1289,7 +1289,7 @@ module Executables = struct
|
|||
| Some (loc, _) ->
|
||||
let func =
|
||||
match file_kind with
|
||||
| Jbuild -> Dloc.warn
|
||||
| Jbuild -> Errors.warn
|
||||
| Dune -> Errors.fail
|
||||
in
|
||||
func loc
|
||||
|
|
|
@ -33,3 +33,66 @@ let fail_opt t fmt =
|
|||
match t with
|
||||
| None -> die fmt
|
||||
| Some t -> fail t fmt
|
||||
|
||||
let file_line path n =
|
||||
Io.with_file_in ~binary:false path
|
||||
~f:(fun ic ->
|
||||
for _ = 1 to n - 1 do
|
||||
ignore (input_line ic)
|
||||
done;
|
||||
input_line ic
|
||||
)
|
||||
|
||||
let file_lines path ~start ~stop =
|
||||
Io.with_file_in ~binary:true path
|
||||
~f:(fun ic ->
|
||||
let rec aux acc lnum =
|
||||
if lnum > stop then
|
||||
List.rev acc
|
||||
else if lnum < start then
|
||||
(ignore (input_line ic);
|
||||
aux acc (lnum + 1))
|
||||
else
|
||||
let line = input_line ic in
|
||||
aux ((string_of_int lnum, line) :: acc) (lnum + 1)
|
||||
in
|
||||
aux [] 1
|
||||
)
|
||||
|
||||
let print ppf loc =
|
||||
let { Loc.start; stop } = loc in
|
||||
let start_c = start.pos_cnum - start.pos_bol in
|
||||
let stop_c = stop.pos_cnum - start.pos_bol in
|
||||
let num_lines = stop.pos_lnum - start.pos_lnum in
|
||||
let pp_file_excerpt pp () =
|
||||
let whole_file = start_c = 0 && stop_c = 0 in
|
||||
if not whole_file then
|
||||
let path = Path.of_string start.pos_fname in
|
||||
if Path.exists path then
|
||||
let line = file_line path start.pos_lnum in
|
||||
if stop_c <= String.length line then
|
||||
let len = stop_c - start_c in
|
||||
Format.fprintf pp "%s\n%*s\n" line
|
||||
stop_c
|
||||
(String.make len '^')
|
||||
else if num_lines <= 10 then
|
||||
let lines = file_lines path ~start:start.pos_lnum ~stop:stop.pos_lnum in
|
||||
let last_lnum = Option.map ~f:fst (List.last lines) in
|
||||
let padding_width = Option.value_exn
|
||||
(Option.map ~f:String.length last_lnum) in
|
||||
List.iter ~f:(fun (lnum, l) ->
|
||||
Format.fprintf pp "%*s: %s\n" padding_width lnum l)
|
||||
lines
|
||||
in
|
||||
Format.fprintf ppf
|
||||
"@{<loc>File \"%s\", line %d, characters %d-%d:@}@\n%a"
|
||||
start.pos_fname start.pos_lnum start_c stop_c
|
||||
pp_file_excerpt ()
|
||||
|
||||
(* This is ugly *)
|
||||
let printer = ref (Printf.eprintf "%s%!")
|
||||
let print_to_console s = !printer s
|
||||
|
||||
let warn t fmt =
|
||||
kerrf ~f:print_to_console
|
||||
("%a@{<warning>Warning@}: " ^^ fmt ^^ "@.") print t
|
||||
|
|
|
@ -27,3 +27,13 @@ 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
|
||||
|
||||
(** Prints "File ..., line ..., characters ...:\n" *)
|
||||
val print : Format.formatter -> Loc.t -> unit
|
||||
|
||||
(** Prints a warning *)
|
||||
val warn : Loc.t -> ('a, Format.formatter, unit) format -> 'a
|
||||
|
||||
val print_to_console : string -> unit
|
||||
|
||||
val printer : (string -> unit) ref
|
||||
|
|
|
@ -89,12 +89,12 @@ let load_jbuild_ignore path =
|
|||
if Filename.dirname fn = Filename.current_dir_name then
|
||||
true
|
||||
else begin
|
||||
Dloc.(warn (Loc.of_pos
|
||||
( Path.to_string path
|
||||
, i + 1, 0
|
||||
, String.length fn
|
||||
))
|
||||
"subdirectory expression %s ignored" fn);
|
||||
Errors.(warn (Loc.of_pos
|
||||
( Path.to_string path
|
||||
, i + 1, 0
|
||||
, String.length fn
|
||||
))
|
||||
"subdirectory expression %s ignored" fn);
|
||||
false
|
||||
end)
|
||||
|> String.Set.of_list
|
||||
|
|
|
@ -89,6 +89,4 @@ module No_io = struct
|
|||
module Io = struct end
|
||||
end
|
||||
|
||||
(* This is ugly *)
|
||||
let printer = ref (Printf.eprintf "%s%!")
|
||||
let print_to_console s = !printer s
|
||||
let print_to_console = Errors.print_to_console
|
||||
|
|
|
@ -1138,7 +1138,7 @@ let report_lib_error ppf (e : Error.t) =
|
|||
| No_solution_found_for_select { loc } ->
|
||||
Format.fprintf ppf
|
||||
"%a@{<error>Error@}: No solution found for this select form.\n"
|
||||
Dloc.print loc
|
||||
Errors.print loc
|
||||
| Dependency_cycle cycle ->
|
||||
Format.fprintf ppf
|
||||
"@{<error>Error@}: Dependency cycle detected between the \
|
||||
|
|
|
@ -16,7 +16,7 @@ let print ?(skip_trailing_cr=Sys.win32) path1 path2 =
|
|||
in
|
||||
let loc = Loc.in_file file1 in
|
||||
let fallback () =
|
||||
die "%aFiles %s and %s differ." Dloc.print loc
|
||||
die "%aFiles %s and %s differ." Errors.print loc
|
||||
(Path.to_string_maybe_quoted path1)
|
||||
(Path.to_string_maybe_quoted path2)
|
||||
in
|
||||
|
@ -24,7 +24,7 @@ let print ?(skip_trailing_cr=Sys.win32) path1 path2 =
|
|||
match Bin.which "diff" with
|
||||
| None -> fallback ()
|
||||
| Some prog ->
|
||||
Format.eprintf "%a@?" Dloc.print loc;
|
||||
Format.eprintf "%a@?" Errors.print loc;
|
||||
Process.run ~dir ~env:Env.initial Strict prog
|
||||
(List.concat
|
||||
[ ["-u"]
|
||||
|
|
|
@ -121,7 +121,7 @@ let report exn =
|
|||
else
|
||||
p.loc
|
||||
in
|
||||
Option.iter loc ~f:(fun loc -> Dloc.print ppf loc);
|
||||
Option.iter loc ~f:(fun loc -> Errors.print ppf loc);
|
||||
p.pp ppf;
|
||||
Format.pp_print_flush ppf ();
|
||||
let s = Buffer.contents err_buf in
|
||||
|
|
|
@ -196,7 +196,7 @@ let go ?(log=Log.no_log) ?(config=Config.default)
|
|||
; waiting_for_available_job = Queue.create ()
|
||||
}
|
||||
in
|
||||
printer := print t;
|
||||
Errors.printer := print t;
|
||||
let fiber =
|
||||
Fiber.Var.set t_var t
|
||||
(Fiber.with_error_handler (fun () -> fiber) ~on_error:Report_error.report)
|
||||
|
|
|
@ -88,7 +88,7 @@ module Of_sexp = struct
|
|||
match Univ_map.find parsing_context (Syntax.key syntax) with
|
||||
| Some (0, _) ->
|
||||
let last = Option.value_exn (List.last entries) in
|
||||
Dloc.warn (Dsexp.Ast.loc last)
|
||||
Errors.warn (Dsexp.Ast.loc last)
|
||||
"Field %S is present several times, previous occurrences are ignored."
|
||||
name
|
||||
| _ ->
|
||||
|
|
|
@ -856,7 +856,7 @@ module Action = struct
|
|||
assert false
|
||||
| Unnamed v :: _ -> [Path v]
|
||||
| [] ->
|
||||
Dloc.warn loc "Variable '%s' used with no explicit \
|
||||
Errors.warn loc "Variable '%s' used with no explicit \
|
||||
dependencies@." key;
|
||||
[Value.String ""]
|
||||
end
|
||||
|
@ -874,7 +874,7 @@ module Action = struct
|
|||
| [] -> ()
|
||||
| x :: _ ->
|
||||
let loc = String_with_vars.loc x in
|
||||
Dloc.warn loc
|
||||
Errors.warn loc
|
||||
"Aliases must not have targets, this target will be ignored.\n\
|
||||
This will become an error in the future.";
|
||||
end;
|
||||
|
|
Loading…
Reference in New Issue