Skip to content

Commit

Permalink
GPR#1120: emacs-friendly location
Browse files Browse the repository at this point in the history
  • Loading branch information
@Octachron
Octachron committed Mar 28, 2017
1 parent 5357b17 commit f4f5576
Show file tree
Hide file tree
Showing 9 changed files with 86 additions and 51 deletions.
6 changes: 4 additions & 2 deletions testsuite/tests/printed-signatures/pervasives_leitmotiv.reference
View file
Expand Up @@ -4,6 +4,8 @@ val f : Pervasives/1.fpclass -> Pervasives/2.fpclass
File "pervasives_leitmotiv.ml", line 1:
Warning 63: A signature contained items which could not be printed properly,
due to name collisions between identifiers:
Module Pervasives/1 was defined at line 3, characters 0-49
Module Pervasives/2 was defined in File "_none_", line 1
file "pervasives_leitmotiv.ml", line 3, characters 0-49:
Definition of module Pervasives/1
file "_none_", line 1:
Definition of module Pervasives/2
The resulting printed signature is not compilable.
6 changes: 4 additions & 2 deletions testsuite/tests/printed-signatures/pr4791.reference
View file
Expand Up @@ -3,6 +3,8 @@ module B : sig type t = B val f : t/2 -> t/1 end
File "pr4791.ml", line 1:
Warning 63: A signature contained items which could not be printed properly,
due to name collisions between identifiers:
Type t/1 was defined at line 5, characters 2-12
Type t/2 was defined at line 1, characters 0-10
file "pr4791.ml", line 5, characters 2-12:
Definition of type t/1
file "pr4791.ml", line 1, characters 0-10:
Definition of type t/2
The resulting printed signature is not compilable.
6 changes: 4 additions & 2 deletions testsuite/tests/printed-signatures/pr6323.reference
View file
Expand Up @@ -5,6 +5,8 @@ module DT :
File "pr6323.ml", line 1:
Warning 63: A signature contained items which could not be printed properly,
due to name collisions between identifiers:
Type t/1 was defined at line 8, characters 2-24
Type t/2 was defined at line 1, characters 0-26
file "pr6323.ml", line 8, characters 2-24:
Definition of type t/1
file "pr6323.ml", line 1, characters 0-26:
Definition of type t/2
The resulting printed signature is not compilable.
6 changes: 4 additions & 2 deletions testsuite/tests/printed-signatures/pr7402.reference
View file
Expand Up @@ -3,6 +3,8 @@ module F : sig module M : sig val v : M.t end val v : M/2.t end
File "pr7402.ml", line 1:
Warning 63: A signature contained items which could not be printed properly,
due to name collisions between identifiers:
Module M/1 was defined at line 7, characters 0-39
Module M/2 was defined at line 1, characters 0-70
file "pr7402.ml", line 7, characters 0-39:
Definition of module M/1
file "pr7402.ml", line 1, characters 0-70:
Definition of module M/2
The resulting printed signature is not compilable.
54 changes: 36 additions & 18 deletions testsuite/tests/typing-misc/pr6416.ml
View file
Expand Up @@ -18,8 +18,10 @@ Error: Signature mismatch:
val f : t/1 -> unit
is not included in
val f : t/2 -> unit
Type t/1 was defined at line 6, characters 4-14
Type t/2 was defined at line 2, characters 2-12
file "", line 6, characters 4-14:
Definition of type t/1
file "", line 2, characters 2-12:
Definition of type t/2
|}]

module N = struct
Expand All @@ -39,8 +41,10 @@ Error: Signature mismatch:
is not included in
type u = A of t/1
The types for field A are not equal.
Type t/1 was defined at line 2, characters 2-11
Type t/2 was defined at line 4, characters 9-19
file "", line 2, characters 2-11:
Definition of type t/1
file "", line 4, characters 9-19:
Definition of type t/2
|}]

module K = struct
Expand All @@ -66,8 +70,10 @@ Error: Signature mismatch:
functor (X : s/2) -> sig end
At position module A(X : <here>) : ...
Modules do not match: s/2 is not included in s/1
Module type s/1 was defined at line 5, characters 6-19
Module type s/2 was defined at line 2, characters 2-15
file "", line 5, characters 6-19:
Definition of module type s/1
file "", line 2, characters 2-15:
Definition of module type s/2
|}]

module L = struct
Expand All @@ -90,8 +96,10 @@ Error: Signature mismatch:
is not included in
type t = A of T/1.t
The types for field A are not equal.
Module T/1 was defined at line 2, characters 2-30
Module T/2 was defined at line 5, characters 6-34
file "", line 2, characters 2-30:
Definition of module T/1
file "", line 5, characters 6-34:
Definition of module T/2
|}]

module O = struct
Expand All @@ -112,10 +120,14 @@ Error: Signature mismatch:
val f : (module s/1) -> t/2 -> t/1
is not included in
val f : (module s/2) -> t/2 -> t/2
Type t/1 was defined at line 5, characters 23-33
Type t/2 was defined at line 3, characters 2-12
Module type s/1 was defined at line 5, characters 9-22
Module type s/2 was defined at line 2, characters 2-15
file "", line 5, characters 23-33:
Definition of type t/1
file "", line 3, characters 2-12:
Definition of type t/2
file "", line 5, characters 9-22:
Definition of module type s/1
file "", line 2, characters 2-15:
Definition of module type s/2
|}]

module P = struct
Expand All @@ -136,8 +148,10 @@ Error: Signature mismatch:
val f : a/2 -> 'a -> a/1
is not included in
val f : a/2 -> (module a) -> a/2
Type a/1 was defined at line 5, characters 12-22
Type a/2 was defined at line 3, characters 2-12
file "", line 5, characters 12-22:
Definition of type a/1
file "", line 3, characters 2-12:
Definition of type a/2
|}]

module Q = struct
Expand All @@ -163,8 +177,10 @@ Error: Signature mismatch:
class b : a/1
The first class type has no method m
The public method c cannot be hidden
Class a/1 was defined at line 2, characters 2-36
Class a/2 was defined at line 5, characters 4-74
file "", line 2, characters 2-36:
Definition of class a/1
file "", line 5, characters 4-74:
Definition of class a/2
|}]

module R = struct
Expand All @@ -188,8 +204,10 @@ Error: Signature mismatch:
does not match
class type b = a/1
The first class type has no method m
Class type a/1 was defined at line 2, characters 2-42
Class type a/2 was defined at line 5, characters 4-29
file "", line 2, characters 2-42:
Definition of class type a/1
file "", line 5, characters 4-29:
Definition of class type a/2
|}]

module S = struct
Expand Down
6 changes: 4 additions & 2 deletions testsuite/tests/typing-misc/pr6634.ml
View file
Expand Up @@ -13,6 +13,8 @@ Error: Signature mismatch:
type t = [ `T of t/2 ]
is not included in
type t = [ `T of t/1 ]
Type t/1 was defined at line 1, characters 0-12
Type t/2 was defined at line 2, characters 59-77
file "", line 1, characters 0-12:
Definition of type t/1
file "", line 2, characters 59-77:
Definition of type t/2
|}]
18 changes: 12 additions & 6 deletions testsuite/tests/typing-misc/unique_names_in_unification.ml
View file
Expand Up @@ -11,8 +11,10 @@ val x : t = A
Line _, characters 27-28:
Error: This expression has type t/2 but an expression was expected of type
t/1
Type t/1 was defined at line 4, characters 2-12
Type t/2 was defined at line 1, characters 0-10
file "", line 4, characters 2-12:
Definition of type t/1
file "", line 1, characters 0-10:
Definition of type t/2
|}]

module M = struct type t = B end
Expand All @@ -30,8 +32,10 @@ val y : M.t = M.B
Line _, characters 34-35:
Error: This expression has type M/2.t but an expression was expected of type
M/1.t
Module M/1 was defined at line 4, characters 2-41
Module M/2 was defined at line 1, characters 0-32
file "", line 4, characters 2-41:
Definition of module M/1
file "", line 1, characters 0-32:
Definition of module M/2
|}]

type t = D
Expand All @@ -43,6 +47,8 @@ type t = D
Line _, characters 25-26:
Error: This expression has type t/1 but an expression was expected of type
t/2
Type t/1 was defined at line 1, characters 0-10
Type t/2 was defined at line 1, characters 0-10
file "", line 1, characters 0-10:
Definition of type t/1
file "", line 1, characters 0-10:
Definition of type t/2
|}]
2 changes: 0 additions & 2 deletions testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml.reference
View file
Expand Up @@ -123,8 +123,6 @@ val ambiguous__module_variable :
^
Warning 41: A belongs to several types: t/1 t/2
The first one was selected. Please disambiguate if this is wrong.
Type t/1 was defined at line 164, characters 0-40
Type t/2 was defined at line 136, characters 0-47
Characters 42-138:
.........................................function
| A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
Expand Down
33 changes: 18 additions & 15 deletions typing/printtyp.ml
View file
Expand Up @@ -57,11 +57,11 @@ module Namespace = struct

let show =
function
| Type -> "Type"
| Module -> "Module"
| Module_type -> "Module type"
| Class -> "Class"
| Class_type -> "Class type"
| Type -> "type"
| Module -> "module"
| Module_type -> "module type"
| Class -> "class"
| Class_type -> "class type"
| Other -> ""


Expand Down Expand Up @@ -160,29 +160,32 @@ let pp_loc ppf loc =
let file = pos.pos_fname and line = pos.pos_lnum
and startchar = pos.pos_cnum - pos.pos_bol in
let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
if file = "//toplevel//" || file = !Location.input_name then
fprintf ppf "at @{<loc>"
else fprintf ppf "in @{<loc>File \"%s\", " file;
fprintf ppf "@{<loc>file \"%s\", " file;
fprintf ppf "line %i" line;
if startchar >= 0 then
fprintf ppf ", characters %i-%i" startchar endchar;
fprintf ppf "@}"

let pp_explanation ppf r=
Format.fprintf ppf "@[<v 2>%a:@;Definition of %s %s@]"
pp_loc r.location (Namespace.show r.kind) r.name

let pp_conflicts ppf l =
let pp_explanation ppf r=
Format.fprintf ppf "%s %s was defined %a"
(Namespace.show r.kind) r.name pp_loc r.location in
Format.fprintf ppf "@[<v>%a@]" (Format.pp_print_list pp_explanation) l
Format.fprintf ppf "@[<v>%a@]" (Format.pp_print_list pp_explanation) l

let get_conflicts () =
!conflict_explanations
|> M.bindings |> List.map snd |> List.sort Pervasives.compare
let reset_conflicts () = conflict_explanations := M.empty

let print_conflicts ?(sep=fun ppf -> Format.fprintf ppf "@;") ppf =
let l = get_conflicts () in
if l = [] then () else
Format.fprintf ppf "%t%a" sep pp_conflicts l
let l =
List.filter (* remove toplevle location, which are not really useful *)
( fun a -> a.location.Location.loc_start.Lexing.pos_fname <> "//toplevel//" )
(get_conflicts ()) in
match l with
| [] -> ()
| l -> Format.fprintf ppf "%t%a" sep pp_conflicts l

let protected = ref S.empty
let add_protected id = protected := S.add (Ident.name id) !protected
Expand Down

0 comments on commit f4f5576

Please sign in to comment.