Fixing #7100 (lost of main file location in case of Ltac failure in other file).

3 files changed, 11 insertions, 4 deletions

diff --git a/lib/loc.ml b/lib/loc.ml
index 6f5283aab..1a09091bf 100644
--- a/lib/loc.ml
+++ b/lib/loc.ml
@@ -62,6 +62,11 @@ let merge_opt l1 l2 = match l1, l2 with
   | None, Some l  -> Some l
   | Some l1, Some l2 -> Some (merge l1 l2)
 
+let finer l1 l2 = match l1, l2 with
+  | None, _    -> false
+  | Some l , None -> true
+  | Some l1, Some l2 -> l1.fname = l2.fname && merge l1 l2 = l2
+
 let unloc loc = (loc.bp, loc.ep)
 
 let shift_loc kb kp loc = { loc with bp = loc.bp + kb ; ep = loc.ep + kp }
diff --git a/lib/loc.mli b/lib/loc.mli
index 813c45fbb..23df1ebd9 100644
--- a/lib/loc.mli
+++ b/lib/loc.mli
@@ -42,6 +42,10 @@ val merge : t -> t -> t
 val merge_opt : t option -> t option -> t option
 (** Merge locations, usually generating the largest possible span *)
 
+val finer : t option -> t option -> bool
+(** Answers [true] when the first location is more defined, or, when
+    both defined, included in the second one *)
+
 val shift_loc : int -> int -> t -> t
 (** [shift_loc loc n p] shifts the beginning of location by [n] and
     the end by [p]; it is assumed that the shifts do not change the
diff --git a/plugins/ltac/tactic_debug.ml b/plugins/ltac/tactic_debug.ml
index e55b49fb4..bb815dcb3 100644
--- a/plugins/ltac/tactic_debug.ml
+++ b/plugins/ltac/tactic_debug.ml
@@ -402,8 +402,6 @@ let skip_extensions trace =
   | [] -> [] in
   List.rev (aux (List.rev trace))
 
-let finer_loc loc1 loc2 = Loc.merge_opt loc1 loc2 = loc2
-
 let extract_ltac_trace ?loc trace =
   let trace = skip_extensions trace in
   let (tloc,c),tail = List.sep_last trace in
@@ -411,7 +409,7 @@ let extract_ltac_trace ?loc trace =
     (* We entered a user-defined tactic,
        we display the trace with location of the call *)
     let msg = hov 0 (explain_ltac_call_trace c tail loc ++ fnl()) in
-    (if finer_loc loc tloc then loc else tloc), Some msg
+    (if Loc.finer loc tloc then loc else tloc), Some msg
   else
     (* We entered a primitive tactic, we don't display trace but
        report on the finest location *)
@@ -420,7 +418,7 @@ let extract_ltac_trace ?loc trace =
       let rec aux best_loc = function
         | (loc,_)::tail ->
            if Option.is_empty best_loc ||
-              not (Option.is_empty loc) && finer_loc loc best_loc
+              not (Option.is_empty loc) && Loc.finer loc best_loc
            then
              aux loc tail
            else