diff options
| -rw-r--r-- | src/files_map.adb | 68 | ||||
| -rw-r--r-- | src/files_map.ads | 6 | ||||
| -rw-r--r-- | src/vhdl/errorout.adb | 30 |
3 files changed, 76 insertions, 28 deletions
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; |