[Ada] Fixes in the use of spans for error locations

gcc/ada/

	* errout.adb (Error_Msg_NEL): Extract span from node.
	(First_And_Last_Nodes): Use spans for subtype indications and
	attribute definition clauses.
	(Write_Source_Code_Lines): Fix for tabulation characters. Change
	output for large spans to skip intermediate lines.
	* sem_case.adb (Check_Choice_Set): Report duplicate choice on
	the Original_Node for the case.
	(Generic_Check_Choices): Set the Original_Node for the rewritten
	case, so that the subtree used in spans has the correct
	locations.

2 files changed, 181 insertions, 32 deletions

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 97fd9d4..2b4f278 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -1430,8 +1430,14 @@ package body Errout is
       E             : Node_Or_Entity_Id;
       Flag_Location : Source_Ptr)
    is
+      Fst, Lst : Node_Id;
    begin
-      Error_Msg_NEL (Msg, N, E, To_Span (Flag_Location));
+      First_And_Last_Nodes (N, Fst, Lst);
+      Error_Msg_NEL
+        (Msg, N, E,
+         To_Span (Ptr   => Flag_Location,
+                  First => Source_Ptr'Min (Flag_Location, First_Sloc (Fst)),
+                  Last  => Source_Ptr'Max (Flag_Location, Last_Sloc (Lst))));
    end Error_Msg_NEL;
 
    procedure Error_Msg_NEL
@@ -1757,7 +1763,7 @@ package body Errout is
            and then Get_Source_File_Index (Loc) = Sfile
          then
             Latest := Norig;
-            Lloc     := Loc;
+            Lloc   := Loc;
          end if;
 
          return OK_Orig;
@@ -1782,6 +1788,8 @@ package body Errout is
                        | N_Pragma
                        | N_Use_Type_Clause
                        | N_With_Clause
+                       | N_Attribute_Definition_Clause
+                       | N_Subtype_Indication
       then
          Earliest := Orig;
          Eloc := Loc;
@@ -2284,11 +2292,35 @@ package body Errout is
 
       procedure Write_Source_Code_Lines (Span : Source_Span) is
 
+         function Get_Line_End
+           (Buf : Source_Buffer_Ptr;
+            Loc : Source_Ptr) return Source_Ptr;
+         --  Get the source location for the end of the line in Buf for Loc
+
+         function Get_Line_Start
+           (Buf : Source_Buffer_Ptr;
+            Loc : Source_Ptr) return Source_Ptr;
+         --  Get the source location for the start of the line in Buf for Loc
+
          function Image (X : Positive; Width : Positive) return String;
          --  Output number X over Width characters, with whitespace padding.
          --  Only output the low-order Width digits of X, if X is larger than
          --  Width digits.
 
+         procedure Write_Buffer
+           (Buf   : Source_Buffer_Ptr;
+            First : Source_Ptr;
+            Last  : Source_Ptr);
+         --  Output the characters from First to Last position in Buf, using
+         --  Write_Buffer_Char.
+
+         procedure Write_Buffer_Char
+           (Buf : Source_Buffer_Ptr;
+            Loc : Source_Ptr);
+         --  Output the characters at position Loc in Buf, translating ASCII.HT
+         --  in a suitable number of spaces so that the output is not modified
+         --  by starting in a different column that 1.
+
          procedure Write_Line_Marker
            (Num   : Pos;
             Mark  : Boolean;
@@ -2297,6 +2329,44 @@ package body Errout is
          --  a Mark to denote the line with the main location when reporting
          --  a span over multiple lines.
 
+         ------------------
+         -- Get_Line_End --
+         ------------------
+
+         function Get_Line_End
+           (Buf : Source_Buffer_Ptr;
+            Loc : Source_Ptr) return Source_Ptr
+         is
+            Cur_Loc : Source_Ptr := Loc;
+         begin
+            while Cur_Loc <= Buf'Last
+              and then Buf (Cur_Loc) /= ASCII.LF
+            loop
+               Cur_Loc := Cur_Loc + 1;
+            end loop;
+
+            return Cur_Loc;
+         end Get_Line_End;
+
+         --------------------
+         -- Get_Line_Start --
+         --------------------
+
+         function Get_Line_Start
+           (Buf : Source_Buffer_Ptr;
+            Loc : Source_Ptr) return Source_Ptr
+         is
+            Cur_Loc : Source_Ptr := Loc;
+         begin
+            while Cur_Loc > Buf'First
+              and then Buf (Cur_Loc - 1) /= ASCII.LF
+            loop
+               Cur_Loc := Cur_Loc - 1;
+            end loop;
+
+            return Cur_Loc;
+         end Get_Line_Start;
+
          -----------
          -- Image --
          -----------
@@ -2317,6 +2387,50 @@ package body Errout is
             return Str;
          end Image;
 
+         ------------------
+         -- Write_Buffer --
+         ------------------
+
+         procedure Write_Buffer
+           (Buf   : Source_Buffer_Ptr;
+            First : Source_Ptr;
+            Last  : Source_Ptr)
+         is
+         begin
+            for Loc in First .. Last loop
+               Write_Buffer_Char (Buf, Loc);
+            end loop;
+         end Write_Buffer;
+
+         -----------------------
+         -- Write_Buffer_Char --
+         -----------------------
+
+         procedure Write_Buffer_Char
+           (Buf : Source_Buffer_Ptr;
+            Loc : Source_Ptr)
+         is
+         begin
+            --  If the character ASCII.HT is not the last one in the file,
+            --  output as many spaces as the character represents in the
+            --  original source file.
+
+            if Buf (Loc) = ASCII.HT
+              and then Loc < Buf'Last
+            then
+               for X in Get_Column_Number (Loc) ..
+                        Get_Column_Number (Loc + 1) - 1
+               loop
+                  Write_Char (' ');
+               end loop;
+
+            --  Otherwise output the character itself
+
+            else
+               Write_Char (Buf (Loc));
+            end if;
+         end Write_Buffer_Char;
+
          -----------------------
          -- Write_Line_Marker --
          -----------------------
@@ -2360,42 +2474,70 @@ package body Errout is
          if Loc >= First_Source_Ptr then
             Buf := Source_Text (Get_Source_File_Index (Loc));
 
-            --  First line of the span with actual source code
+            --  First line of the span with actual source code. We retrieve
+            --  the beginning of the line instead of relying on Col_Fst, as
+            --  ASCII.HT characters change column numbers by possibly more
+            --  than one.
 
             Write_Line_Marker
               (Cur_Line,
                Line_Fst /= Line_Lst and then Cur_Line = Line,
                Width);
-            Write_Str
-              (String (Buf (Fst - Source_Ptr (Col_Fst) + 1  .. Fst - 1)));
+            Write_Buffer (Buf, Get_Line_Start (Buf, Cur_Loc), Cur_Loc - 1);
 
-            --  Output all the lines in the span
+            --  Output the first/caret/last lines of the span, as well as
+            --  lines that are directly above/below the caret if they complete
+            --  the gap with first/last lines, otherwise use ... to denote
+            --  intermediate lines.
 
-            while Cur_Loc <= Buf'Last
-              and then Cur_Loc < Lst
-            loop
-               Write_Char (Buf (Cur_Loc));
-               Cur_Loc := Cur_Loc + 1;
+            declare
+               function Do_Write_Line (Cur_Line : Pos) return Boolean is
+                  (Cur_Line in Line_Fst | Line | Line_Lst
+                     or else
+                   (Cur_Line = Line_Fst + 1 and then Cur_Line = Line - 1)
+                     or else
+                   (Cur_Line = Line + 1 and then Cur_Line = Line_Lst - 1));
+            begin
+               while Cur_Loc <= Buf'Last
+                 and then Cur_Loc < Lst
+               loop
+                  if Do_Write_Line (Cur_Line) then
+                     Write_Buffer_Char (Buf, Cur_Loc);
+                  end if;
 
-               if Buf (Cur_Loc - 1) = ASCII.LF then
-                  Cur_Line := Cur_Line + 1;
-                  Write_Line_Marker
-                    (Cur_Line,
-                     Line_Fst /= Line_Lst and then Cur_Line = Line,
-                     Width);
-               end if;
-            end loop;
+                  Cur_Loc := Cur_Loc + 1;
 
-            --  Output the rest of the last line of the span
+                  if Buf (Cur_Loc - 1) = ASCII.LF then
+                     Cur_Line := Cur_Line + 1;
 
-            while Cur_Loc <= Buf'Last
-              and then Buf (Cur_Loc) /= ASCII.LF
-            loop
-               Write_Char (Buf (Cur_Loc));
-               Cur_Loc := Cur_Loc + 1;
-            end loop;
+                     --  Output ... for skipped lines
 
-            Write_Eol;
+                     if (Cur_Line = Line
+                          and then not Do_Write_Line (Cur_Line - 1))
+                       or else
+                        (Cur_Line = Line + 1
+                          and then not Do_Write_Line (Cur_Line))
+                     then
+                        Write_Str ((1 .. Width - 3 => ' ') & "... | ...");
+                        Write_Eol;
+                     end if;
+
+                     --  Display the line marker if the line should be
+                     --  displayed.
+
+                     if Do_Write_Line (Cur_Line) then
+                        Write_Line_Marker
+                          (Cur_Line,
+                           Line_Fst /= Line_Lst and then Cur_Line = Line,
+                           Width);
+                     end if;
+                  end if;
+               end loop;
+            end;
+
+            --  Output the rest of the last line of the span
+
+            Write_Buffer (Buf, Cur_Loc, Get_Line_End (Buf, Cur_Loc));
 
             --  If the span is on one line, output a second line with caret
             --  sign pointing to location Loc
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index 7f35cfc..b69e0ab 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -531,20 +531,23 @@ package body Sem_Case is
                  and then Compile_Time_Known_Value (C)
                  and then Expr_Value (C) = Lo
                then
-                  Error_Msg_N ("duplication of choice value: &#!", C);
+                  Error_Msg_N
+                    ("duplication of choice value: &#!", Original_Node (C));
 
                --  Not that special case, so just output the integer value
 
                else
                   Error_Msg_Uint_1 := Lo;
-                  Error_Msg_N ("duplication of choice value: ^#!", C);
+                  Error_Msg_N
+                    ("duplication of choice value: ^#!", Original_Node (C));
                end if;
 
             --  Enumeration type
 
             else
                Error_Msg_Name_1 := Choice_Image (Lo, Bounds_Type);
-               Error_Msg_N ("duplication of choice value: %#!", C);
+               Error_Msg_N
+                 ("duplication of choice value: %#!", Original_Node (C));
             end if;
 
          --  More than one choice value, so print range of values
@@ -577,7 +580,9 @@ package body Sem_Case is
                else
                   Error_Msg_Uint_1 := Lo;
                   Error_Msg_Uint_2 := Hi;
-                  Error_Msg_N ("duplication of choice values: ^ .. ^#!", C);
+                  Error_Msg_N
+                    ("duplication of choice values: ^ .. ^#!",
+                     Original_Node (C));
                end if;
 
             --  Enumeration type
@@ -585,7 +590,8 @@ package body Sem_Case is
             else
                Error_Msg_Name_1 := Choice_Image (Lo, Bounds_Type);
                Error_Msg_Name_2 := Choice_Image (Hi, Bounds_Type);
-               Error_Msg_N ("duplication of choice values: % .. %#!", C);
+               Error_Msg_N
+                 ("duplication of choice values: % .. %#!", Original_Node (C));
             end if;
          end if;
       end Dup_Choice;
@@ -1521,6 +1527,7 @@ package body Sem_Case is
                then
                   C := New_Copy (P);
                   Set_Sloc (C, Sloc (Choice));
+                  Set_Original_Node (C, Choice);
 
                   if Expr_Value (Low_Bound (C)) < Expr_Value (Lo) then
                      Set_Low_Bound (C, Lo);