From abfab06bb7620314f636bf5dd2854399e54062d0 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Wed, 15 Mar 2017 06:17:30 +0100
Subject: Add extract_expanded_line.

---
 src/files_map.adb     | 68 +++++++++++++++++++++++++++++++++++++++++++++++++++
 src/files_map.ads     |  6 +++++
 src/vhdl/errorout.adb | 30 ++---------------------
 3 files changed, 76 insertions(+), 28 deletions(-)

(limited to 'src')

diff --git a/src/files_map.adb b/src/files_map.adb
index 66b3a1087..2b6fc7e56 100644
--- a/src/files_map.adb
+++ b/src/files_map.adb
@@ -1019,6 +1019,74 @@ package body Files_Map is
       end;
    end Image;
 
+   --  Compute the length of line that starts at START.  Tabs are expanded to
+   --  compute the length.
+   function Compute_Expanded_Line_Length (File : Source_File_Entry;
+                                          Start : Source_Ptr) return Natural
+   is
+      Buf : constant File_Buffer_Acc := Get_File_Source (File);
+      Pos : Source_Ptr;
+      Len : Natural;
+      C : Character;
+   begin
+      --  Compute line length.
+      Pos := Start;
+      Len := 0;
+      loop
+         C := Buf (Pos);
+         Pos := Pos + 1;
+         exit when C = ASCII.CR or C = ASCII.LF or C = ASCII.EOT;
+         if C = ASCII.HT then
+            --  Expand tab.
+            Len := Len + (Tab_Stop - Len mod Tab_Stop);
+         else
+            Len := Len + 1;
+         end if;
+      end loop;
+      return Len;
+   end Compute_Expanded_Line_Length;
+
+   --  Return the line that starts at START in FILE.  This is slow.
+   function Extract_Expanded_Line (File : Source_File_Entry;
+                                   Start : Source_Ptr) return String
+   is
+      Buf : constant File_Buffer_Acc := Get_File_Source (File);
+      Len : constant Natural := Compute_Expanded_Line_Length (File, Start);
+      Res : String (1 .. Len);
+      P : Natural;
+      Pos : Source_Ptr;
+      C : Character;
+   begin
+      Pos := Start;
+      P := 0;
+      loop
+         C := Buf (Pos);
+         Pos := Pos + 1;
+         exit when C = ASCII.CR or C = ASCII.LF or C = ASCII.EOT;
+         if C = ASCII.HT then
+            --  Expand tab.
+            loop
+               P := P + 1;
+               Res (P) := ' ';
+               exit when P mod Tab_Stop = 0;
+            end loop;
+         else
+            P := P + 1;
+            Res (P) := C;
+         end if;
+      end loop;
+      pragma Assert (P = Res'Last);
+      return Res;
+   end Extract_Expanded_Line;
+
+   function Extract_Expanded_Line (File : Source_File_Entry;
+                                   Line : Natural) return String
+   is
+      Start : constant Source_Ptr := Line_To_Position (File, Line);
+   begin
+      return Extract_Expanded_Line (File, Start);
+   end Extract_Expanded_Line;
+
    -- Debug procedures.
    procedure Debug_Source_Lines (File: Source_File_Entry);
    pragma Unreferenced (Debug_Source_Lines);
diff --git a/src/files_map.ads b/src/files_map.ads
index 55933ebc3..b3fa5b7fe 100644
--- a/src/files_map.ads
+++ b/src/files_map.ads
@@ -177,6 +177,12 @@ package Files_Map is
                                    Line : out Natural;
                                    Col : out Natural);
 
+   --  Return the line LINE from FILE (without end of line).  The line is
+   --  expanded: tabs are replaced by spaces according to Tab_Stop.  This
+   --  function is slow.
+   function Extract_Expanded_Line (File : Source_File_Entry;
+                                   Line : Natural) return String;
+
    --  Return the image of LOC using the "FILENAME:LINE:COL" format or
    --  "LINE:COL" format if FILENAME is false;
    function Image (Loc : Location_Type; Filename : Boolean := True)
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index 6d1a43d06..55c367f85 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -574,34 +574,8 @@ package body Errorout is
       if Flag_Caret_Diagnostics
         and then (File /= No_Source_File_Entry and Line /= 0)
       then
-         declare
-            Buf : constant File_Buffer_Acc := Get_File_Source (File);
-            Pos : Source_Ptr;
-            Len : Natural;
-            C : Character;
-         begin
-            --  Compute line length.
-            Pos := Line_To_Position (File, Line);
-            Len := 0;
-            loop
-               C := Buf (Pos);
-               Pos := Pos + 1;
-               exit when C = ASCII.CR or C = ASCII.LF or C = ASCII.EOT;
-               if C = ASCII.HT then
-                  --  Expand tab.
-                  loop
-                     Put (' ');
-                     Len := Len + 1;
-                     exit when Len mod Tab_Stop = 0;
-                  end loop;
-               else
-                  Put (C);
-                  Len := Len + 1;
-               end if;
-            end loop;
-            Put_Line;
-            Put_Line ((1 .. Col => ' ') & '^');
-         end;
+         Put_Line (Extract_Expanded_Line (File, Line));
+         Put_Line ((1 .. Col => ' ') & '^');
       end if;
    end Report_Msg;
 
-- 
cgit v1.2.3