From 59892ba3127112fd2c5c6b3cd93ab4f29502ebb2 Mon Sep 17 00:00:00 2001
From: Alasdair Armstrong
Date: Wed, 13 Sep 2017 18:28:06 +0100
Subject: Fixed code display in error messages that span multiple lines

---
 src/reporting_basic.ml | 38 ++++++++++++++++++++++++++++++++++++--
 1 file changed, 36 insertions(+), 2 deletions(-)

(limited to 'src/reporting_basic.ml')

diff --git a/src/reporting_basic.ml b/src/reporting_basic.ml
index 2bd5d5bc..e552dca4 100644
--- a/src/reporting_basic.ml
+++ b/src/reporting_basic.ml
@@ -99,9 +99,16 @@ let rec skip_lines in_chan = function
   | n when n <= 0 -> ()
   | n -> input_line in_chan; skip_lines in_chan (n - 1)
 
+let rec read_lines in_chan = function
+  | n when n <= 0 -> []
+  | n ->
+     let l = input_line in_chan in
+     let ls = read_lines in_chan (n - 1) in
+     l :: ls
+
 let termcode n = "\x1B[" ^ string_of_int n ^ "m"
 
-let print_code ff fname lnum1 cnum1 cnum2 =
+let print_code1 ff fname lnum1 cnum1 cnum2 =
   try
     let in_chan = open_in fname in
     begin
@@ -119,6 +126,31 @@ let print_code ff fname lnum1 cnum1 cnum2 =
     end
   with _ -> ()
 
+let print_code2 ff fname lnum1 cnum1 lnum2 cnum2 =
+  try
+    let in_chan = open_in fname in
+    begin
+      try
+        skip_lines in_chan (lnum1 - 1);
+        let line = input_line in_chan in
+        Format.fprintf ff "%s%s%s%s\n"
+                       (Str.string_before line cnum1)
+                       (termcode 41)
+                       (Str.string_after line cnum1)
+                       (termcode 49);
+        let lines = read_lines in_chan (lnum2 - lnum1 - 1) in
+        List.iter (fun l -> Format.fprintf ff "%s%s%s\n" (termcode 41) l (termcode 49)) lines;
+        let line = input_line in_chan in
+        Format.fprintf ff "%s%s%s%s"
+                       (termcode 41)
+                       (Str.string_before line cnum2)
+                       (termcode 49)
+                       (Str.string_after line cnum2);
+        close_in in_chan
+      with e -> (close_in_noerr in_chan; print_endline (Printexc.to_string e))
+    end
+  with _ -> ()
+
 let format_pos2 ff p1 p2 =
   let open Lexing in
   begin
@@ -126,7 +158,9 @@ let format_pos2 ff p1 p2 =
                    p1.pos_fname
                    p1.pos_lnum (p1.pos_cnum - p1.pos_bol + 1)
                    p2.pos_lnum (p2.pos_cnum - p2.pos_bol);
-    print_code ff p1.pos_fname p1.pos_lnum (p1.pos_cnum - p1.pos_bol) (p2.pos_cnum - p2.pos_bol);
+    if p1.pos_lnum == p2.pos_lnum
+    then print_code1 ff p1.pos_fname p1.pos_lnum (p1.pos_cnum - p1.pos_bol) (p2.pos_cnum - p2.pos_bol)
+    else print_code2 ff p1.pos_fname p1.pos_lnum (p1.pos_cnum - p1.pos_bol) p2.pos_lnum (p2.pos_cnum - p2.pos_bol);
     Format.pp_print_flush ff ()
   end
 
-- 
cgit v1.2.3