[Ada] Use spans instead of locations for compiler diagnostics

gcc/ada/

	* errout.adb: (Error_Msg_Internal): Use span instead of
	location.
	(Error_Msg, Error_Msg_NEL): Add versions with span parameter.
	(Error_Msg_F, Error_Msg_FE, Error_Msg_N, Error_Msg_NE,
	Error_Msg_NW): Retrieve span from node.
	(First_Node): Use the new First_And_Last_Nodes.
	(First_And_Last_Nodes): Expand on previous First_Node. Apply to
	other nodes than expressions.
	(First_Sloc): Protect against inconsistent locations.
	(Last_Node): New function based on First_And_Last_Nodes.
	(Last_Sloc): New function similar to First_Sloc.
	(Output_Messages): Update output when -gnatdF is used. Use
	character ~ for making the span visible, similar to what is done
	in GCC and Clang.
	* errout.ads (Error_Msg, Error_Msg_NEL): Add versions with span
	parameter.
	(First_And_Last_Nodes, Last_Node, Last_Sloc): New subprograms.
	* erroutc.adb: Adapt to Sptr field being a span.
	* erroutc.ads (Error_Msg_Object): Change field Sptr from
	location to span.
	* errutil.adb: Adapt to Sptr field being a span.
	* freeze.adb: Use Errout reporting procedures for nodes to get
	spans.
	* par-ch3.adb: Likewise.
	* par-prag.adb: Likewise.
	* par-util.adb: Likewise.
	* sem_case.adb: Likewise.
	* sem_ch13.adb: Likewise.
	* sem_ch3.adb: Likewise.
	* sem_prag.adb: Likewise.
	* types.ads: (Source_Span): New type for spans.
	(To_Span): Basic constructors for spans.

14 files changed, 479 insertions, 156 deletions

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index cc291c6..97fd9d4 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -98,8 +98,8 @@ package body Errout is
 
    procedure Error_Msg_Internal
      (Msg      : String;
-      Sptr     : Source_Ptr;
-      Optr     : Source_Ptr;
+      Span     : Source_Span;
+      Opan     : Source_Span;
       Msg_Cont : Boolean;
       Node     : Node_Id);
    --  This is the low level routine used to post messages after dealing with
@@ -218,7 +218,7 @@ package body Errout is
       Err_Id    : Error_Msg_Id := Error_Id;
 
    begin
-      Set_Msg_Text (New_Msg, Errors.Table (Error_Id).Sptr);
+      Set_Msg_Text (New_Msg, Errors.Table (Error_Id).Sptr.Ptr);
       Errors.Table (Error_Id).Text := new String'(Msg_Buffer (1 .. Msglen));
 
       --  If in immediate error message mode, output modified error message now
@@ -300,14 +300,19 @@ package body Errout is
    ---------------
 
    --  Error_Msg posts a flag at the given location, except that if the
-   --  Flag_Location points within a generic template and corresponds to an
-   --  instantiation of this generic template, then the actual message will be
-   --  posted on the generic instantiation, along with additional messages
-   --  referencing the generic declaration.
+   --  Flag_Location/Flag_Span points within a generic template and corresponds
+   --  to an instantiation of this generic template, then the actual message
+   --  will be posted on the generic instantiation, along with additional
+   --  messages referencing the generic declaration.
 
    procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
    begin
-      Error_Msg (Msg, Flag_Location, Current_Node);
+      Error_Msg (Msg, To_Span (Flag_Location), Current_Node);
+   end Error_Msg;
+
+   procedure Error_Msg (Msg : String; Flag_Span : Source_Span) is
+   begin
+      Error_Msg (Msg, Flag_Span, Current_Node);
    end Error_Msg;
 
    procedure Error_Msg
@@ -318,7 +323,7 @@ package body Errout is
       Save_Is_Compile_Time_Msg : constant Boolean := Is_Compile_Time_Msg;
    begin
       Is_Compile_Time_Msg := Is_Compile_Time_Pragma;
-      Error_Msg (Msg, Flag_Location, Current_Node);
+      Error_Msg (Msg, To_Span (Flag_Location), Current_Node);
       Is_Compile_Time_Msg := Save_Is_Compile_Time_Msg;
    end Error_Msg;
 
@@ -327,6 +332,17 @@ package body Errout is
       Flag_Location : Source_Ptr;
       N             : Node_Id)
    is
+   begin
+      Error_Msg (Msg, To_Span (Flag_Location), N);
+   end Error_Msg;
+
+   procedure Error_Msg
+     (Msg       : String;
+      Flag_Span : Source_Span;
+      N         : Node_Id)
+   is
+      Flag_Location : constant Source_Ptr := Flag_Span.Ptr;
+
       Sindex : Source_File_Index;
       --  Source index for flag location
 
@@ -429,7 +445,7 @@ package body Errout is
       --  Error_Msg_Internal to place the message in the requested location.
 
       if Instantiation (Sindex) = No_Location then
-         Error_Msg_Internal (Msg, Flag_Location, Flag_Location, False, N);
+         Error_Msg_Internal (Msg, Flag_Span, Flag_Span, False, N);
          return;
       end if;
 
@@ -525,32 +541,32 @@ package body Errout is
                   if Is_Info_Msg then
                      Error_Msg_Internal
                        (Msg      => "info: in inlined body #",
-                        Sptr     => Actual_Error_Loc,
-                        Optr     => Flag_Location,
+                        Span     => To_Span (Actual_Error_Loc),
+                        Opan     => Flag_Span,
                         Msg_Cont => Msg_Cont_Status,
                         Node     => N);
 
                   elsif Is_Warning_Msg then
                      Error_Msg_Internal
                        (Msg      => Warn_Insertion & "in inlined body #",
-                        Sptr     => Actual_Error_Loc,
-                        Optr     => Flag_Location,
+                        Span     => To_Span (Actual_Error_Loc),
+                        Opan     => Flag_Span,
                         Msg_Cont => Msg_Cont_Status,
                         Node     => N);
 
                   elsif Is_Style_Msg then
                      Error_Msg_Internal
                        (Msg      => "style: in inlined body #",
-                        Sptr     => Actual_Error_Loc,
-                        Optr     => Flag_Location,
+                        Span     => To_Span (Actual_Error_Loc),
+                        Opan     => Flag_Span,
                         Msg_Cont => Msg_Cont_Status,
                         Node     => N);
 
                   else
                      Error_Msg_Internal
                        (Msg      => "error in inlined body #",
-                        Sptr     => Actual_Error_Loc,
-                        Optr     => Flag_Location,
+                        Span     => To_Span (Actual_Error_Loc),
+                        Opan     => Flag_Span,
                         Msg_Cont => Msg_Cont_Status,
                         Node     => N);
                   end if;
@@ -561,32 +577,32 @@ package body Errout is
                   if Is_Info_Msg then
                      Error_Msg_Internal
                        (Msg      => "info: in instantiation #",
-                        Sptr     => Actual_Error_Loc,
-                        Optr     => Flag_Location,
+                        Span     => To_Span (Actual_Error_Loc),
+                        Opan     => Flag_Span,
                         Msg_Cont => Msg_Cont_Status,
                         Node     => N);
 
                   elsif Is_Warning_Msg then
                      Error_Msg_Internal
                        (Msg      => Warn_Insertion & "in instantiation #",
-                        Sptr     => Actual_Error_Loc,
-                        Optr     => Flag_Location,
+                        Span     => To_Span (Actual_Error_Loc),
+                        Opan     => Flag_Span,
                         Msg_Cont => Msg_Cont_Status,
                         Node     => N);
 
                   elsif Is_Style_Msg then
                      Error_Msg_Internal
                        (Msg      => "style: in instantiation #",
-                        Sptr     => Actual_Error_Loc,
-                        Optr     => Flag_Location,
+                        Span     => To_Span (Actual_Error_Loc),
+                        Opan     => Flag_Span,
                         Msg_Cont => Msg_Cont_Status,
                         Node     => N);
 
                   else
                      Error_Msg_Internal
                        (Msg      => "instantiation error #",
-                        Sptr     => Actual_Error_Loc,
-                        Optr     => Flag_Location,
+                        Span     => To_Span (Actual_Error_Loc),
+                        Opan     => Flag_Span,
                         Msg_Cont => Msg_Cont_Status,
                         Node     => N);
                   end if;
@@ -605,8 +621,8 @@ package body Errout is
 
          Error_Msg_Internal
            (Msg      => Msg,
-            Sptr     => Actual_Error_Loc,
-            Optr     => Flag_Location,
+            Span     => To_Span (Actual_Error_Loc),
+            Opan     => Flag_Span,
             Msg_Cont => Msg_Cont_Status,
             Node     => N);
       end;
@@ -834,8 +850,13 @@ package body Errout is
    -----------------
 
    procedure Error_Msg_F (Msg : String; N : Node_Id) is
+      Fst, Lst : Node_Id;
    begin
-      Error_Msg_NEL (Msg, N, N, Sloc (First_Node (N)));
+      First_And_Last_Nodes (N, Fst, Lst);
+      Error_Msg_NEL (Msg, N, N,
+                     To_Span (Ptr   => Sloc (Fst),
+                              First => First_Sloc (Fst),
+                              Last  => Last_Sloc (Lst)));
    end Error_Msg_F;
 
    ------------------
@@ -847,8 +868,13 @@ package body Errout is
       N   : Node_Id;
       E   : Node_Or_Entity_Id)
    is
+      Fst, Lst : Node_Id;
    begin
-      Error_Msg_NEL (Msg, N, E, Sloc (First_Node (N)));
+      First_And_Last_Nodes (N, Fst, Lst);
+      Error_Msg_NEL (Msg, N, E,
+                     To_Span (Ptr   => Sloc (Fst),
+                              First => First_Sloc (Fst),
+                              Last  => Last_Sloc (Lst)));
    end Error_Msg_FE;
 
    ------------------------
@@ -857,11 +883,14 @@ package body Errout is
 
    procedure Error_Msg_Internal
      (Msg      : String;
-      Sptr     : Source_Ptr;
-      Optr     : Source_Ptr;
+      Span     : Source_Span;
+      Opan     : Source_Span;
       Msg_Cont : Boolean;
       Node     : Node_Id)
    is
+      Sptr     : constant Source_Ptr := Span.Ptr;
+      Optr     : constant Source_Ptr := Opan.Ptr;
+
       Next_Msg : Error_Msg_Id;
       --  Pointer to next message at insertion point
 
@@ -1136,7 +1165,7 @@ package body Errout is
         ((Text                => new String'(Msg_Buffer (1 .. Msglen)),
           Next                => No_Error_Msg,
           Prev                => No_Error_Msg,
-          Sptr                => Sptr,
+          Sptr                => Span,
           Optr                => Optr,
           Insertion_Sloc      => (if Has_Insertion_Line then Error_Msg_Sloc
                                   else No_Location),
@@ -1196,9 +1225,9 @@ package body Errout is
          if Last_Error_Msg /= No_Error_Msg
            and then Errors.Table (Cur_Msg).Sfile =
                     Errors.Table (Last_Error_Msg).Sfile
-           and then (Sptr > Errors.Table (Last_Error_Msg).Sptr
+           and then (Sptr > Errors.Table (Last_Error_Msg).Sptr.Ptr
                        or else
-                          (Sptr = Errors.Table (Last_Error_Msg).Sptr
+                          (Sptr = Errors.Table (Last_Error_Msg).Sptr.Ptr
                              and then
                                Optr > Errors.Table (Last_Error_Msg).Optr))
          then
@@ -1216,8 +1245,8 @@ package body Errout is
 
                if Errors.Table (Cur_Msg).Sfile = Errors.Table (Next_Msg).Sfile
                then
-                  exit when Sptr < Errors.Table (Next_Msg).Sptr
-                    or else (Sptr = Errors.Table (Next_Msg).Sptr
+                  exit when Sptr < Errors.Table (Next_Msg).Sptr.Ptr
+                    or else (Sptr = Errors.Table (Next_Msg).Sptr.Ptr
                               and then Optr < Errors.Table (Next_Msg).Optr);
                end if;
 
@@ -1364,8 +1393,13 @@ package body Errout is
    -----------------
 
    procedure Error_Msg_N (Msg : String; N : Node_Or_Entity_Id) is
+      Fst, Lst : Node_Id;
    begin
-      Error_Msg_NEL (Msg, N, N, Sloc (N));
+      First_And_Last_Nodes (N, Fst, Lst);
+      Error_Msg_NEL (Msg, N, N,
+                     To_Span (Ptr   => Sloc (N),
+                              First => First_Sloc (Fst),
+                              Last  => Last_Sloc (Lst)));
    end Error_Msg_N;
 
    ------------------
@@ -1377,8 +1411,13 @@ package body Errout is
       N   : Node_Or_Entity_Id;
       E   : Node_Or_Entity_Id)
    is
+      Fst, Lst : Node_Id;
    begin
-      Error_Msg_NEL (Msg, N, E, Sloc (N));
+      First_And_Last_Nodes (N, Fst, Lst);
+      Error_Msg_NEL (Msg, N, E,
+                     To_Span (Ptr   => Sloc (N),
+                              First => First_Sloc (Fst),
+                              Last  => Last_Sloc (Lst)));
    end Error_Msg_NE;
 
    -------------------
@@ -1392,6 +1431,16 @@ package body Errout is
       Flag_Location : Source_Ptr)
    is
    begin
+      Error_Msg_NEL (Msg, N, E, To_Span (Flag_Location));
+   end Error_Msg_NEL;
+
+   procedure Error_Msg_NEL
+     (Msg       : String;
+      N         : Node_Or_Entity_Id;
+      E         : Node_Or_Entity_Id;
+      Flag_Span : Source_Span)
+   is
+   begin
       if Special_Msg_Delete (Msg, N, E) then
          return;
       end if;
@@ -1443,7 +1492,7 @@ package body Errout is
       then
          Debug_Output (N);
          Error_Msg_Node_1 := E;
-         Error_Msg (Msg, Flag_Location, N);
+         Error_Msg (Msg, Flag_Span, N);
 
       else
          Last_Killed := True;
@@ -1463,12 +1512,17 @@ package body Errout is
       Msg   : String;
       N     : Node_Or_Entity_Id)
    is
+      Fst, Lst : Node_Id;
    begin
       if Eflag
         and then In_Extended_Main_Source_Unit (N)
         and then Comes_From_Source (N)
       then
-         Error_Msg_NEL (Msg, N, N, Sloc (N));
+         First_And_Last_Nodes (N, Fst, Lst);
+         Error_Msg_NEL (Msg, N, N,
+                        To_Span (Ptr   => Sloc (N),
+                                 First => First_Sloc (Fst),
+                                 Last  => Last_Sloc (Lst)));
       end if;
    end Error_Msg_NW;
 
@@ -1563,7 +1617,7 @@ package body Errout is
 
          F := Nxt;
          while F /= No_Error_Msg
-           and then Errors.Table (F).Sptr = Errors.Table (Cur).Sptr
+           and then Errors.Table (F).Sptr.Ptr = Errors.Table (Cur).Sptr.Ptr
          loop
             Check_Duplicate_Message (Cur, F);
             F := Errors.Table (F).Next;
@@ -1583,8 +1637,8 @@ package body Errout is
          begin
             if (CE.Warn and not CE.Deleted)
               and then
-                   (Warning_Specifically_Suppressed (CE.Sptr, CE.Text, Tag) /=
-                                                                   No_String
+                   (Warning_Specifically_Suppressed (CE.Sptr.Ptr, CE.Text, Tag)
+                                                                /= No_String
                       or else
                     Warning_Specifically_Suppressed (CE.Optr, CE.Text, Tag) /=
                                                                    No_String)
@@ -1630,23 +1684,40 @@ package body Errout is
    ----------------
 
    function First_Node (C : Node_Id) return Node_Id is
+      Fst, Lst : Node_Id;
+   begin
+      First_And_Last_Nodes (C, Fst, Lst);
+      return Fst;
+   end First_Node;
+
+   --------------------------
+   -- First_And_Last_Nodes --
+   --------------------------
+
+   procedure First_And_Last_Nodes
+     (C                     : Node_Id;
+      First_Node, Last_Node : out Node_Id)
+   is
       Orig     : constant Node_Id           := Original_Node (C);
       Loc      : constant Source_Ptr        := Sloc (Orig);
       Sfile    : constant Source_File_Index := Get_Source_File_Index (Loc);
       Earliest : Node_Id;
+      Latest   : Node_Id;
       Eloc     : Source_Ptr;
+      Lloc     : Source_Ptr;
 
-      function Test_Earlier (N : Node_Id) return Traverse_Result;
+      function Test_First_And_Last (N : Node_Id) return Traverse_Result;
       --  Function applied to every node in the construct
 
-      procedure Search_Tree_First is new Traverse_Proc (Test_Earlier);
+      procedure Search_Tree_First_And_Last is new
+        Traverse_Proc (Test_First_And_Last);
       --  Create traversal procedure
 
-      ------------------
-      -- Test_Earlier --
-      ------------------
+      -------------------------
+      -- Test_First_And_Last --
+      -------------------------
 
-      function Test_Earlier (N : Node_Id) return Traverse_Result is
+      function Test_First_And_Last (N : Node_Id) return Traverse_Result is
          Norig : constant Node_Id    := Original_Node (N);
          Loc   : constant Source_Ptr := Sloc (Norig);
 
@@ -1670,22 +1741,61 @@ package body Errout is
             Eloc     := Loc;
          end if;
 
+         --  Check for later
+
+         if Loc > Lloc
+
+           --  Ignore nodes with no useful location information
+
+           and then Loc /= Standard_Location
+           and then Loc /= No_Location
+
+           --  Ignore nodes from a different file. This ensures against cases
+           --  of strange foreign code somehow being present. We don't want
+           --  wild placement of messages if that happens.
+
+           and then Get_Source_File_Index (Loc) = Sfile
+         then
+            Latest := Norig;
+            Lloc     := Loc;
+         end if;
+
          return OK_Orig;
-      end Test_Earlier;
+      end Test_First_And_Last;
 
-   --  Start of processing for First_Node
+   --  Start of processing for First_And_Last_Nodes
 
    begin
-      if Nkind (Orig) in N_Subexpr then
+      if Nkind (Orig) in N_Subexpr
+                       | N_Declaration
+                       | N_Access_To_Subprogram_Definition
+                       | N_Generic_Instantiation
+                       | N_Subprogram_Declaration
+                       | N_Use_Package_Clause
+                       | N_Array_Type_Definition
+                       | N_Renaming_Declaration
+                       | N_Generic_Renaming_Declaration
+                       | N_Assignment_Statement
+                       | N_Raise_Statement
+                       | N_Simple_Return_Statement
+                       | N_Exit_Statement
+                       | N_Pragma
+                       | N_Use_Type_Clause
+                       | N_With_Clause
+      then
          Earliest := Orig;
          Eloc := Loc;
-         Search_Tree_First (Orig);
-         return Earliest;
+         Latest := Orig;
+         Lloc := Loc;
+         Search_Tree_First_And_Last (Orig);
+         First_Node := Earliest;
+         Last_Node := Latest;
 
       else
-         return Orig;
+         First_Node := Orig;
+         Last_Node := Orig;
       end if;
-   end First_Node;
+   end First_And_Last_Nodes;
 
    ----------------
    -- First_Sloc --
@@ -1694,6 +1804,7 @@ package body Errout is
    function First_Sloc (N : Node_Id) return Source_Ptr is
       SI : constant Source_File_Index := Source_Index (Get_Source_Unit (N));
       SF : constant Source_Ptr        := Source_First (SI);
+      SL : constant Source_Ptr        := Source_Last (SI);
       F  : Node_Id;
       S  : Source_Ptr;
 
@@ -1701,6 +1812,14 @@ package body Errout is
       F := First_Node (N);
       S := Sloc (F);
 
+      --  ??? Protect against inconsistency in locations, by returning S
+      --  immediately if not in the expected range, rather than failing with
+      --  a Constraint_Error when accessing Source_Text(SI)(S)
+
+      if S not in SF .. SL then
+         return S;
+      end if;
+
       --  The following circuit is a bit subtle. When we have parenthesized
       --  expressions, then the Sloc will not record the location of the paren,
       --  but we would like to post the flag on the paren. So what we do is to
@@ -1786,6 +1905,92 @@ package body Errout is
       --  True if S starts with Size_For
    end Is_Size_Too_Small_Message;
 
+   ---------------
+   -- Last_Node --
+   ---------------
+
+   function Last_Node (C : Node_Id) return Node_Id is
+      Fst, Lst : Node_Id;
+   begin
+      First_And_Last_Nodes (C, Fst, Lst);
+      return Lst;
+   end Last_Node;
+
+   ---------------
+   -- Last_Sloc --
+   ---------------
+
+   function Last_Sloc (N : Node_Id) return Source_Ptr is
+      SI : constant Source_File_Index := Source_Index (Get_Source_Unit (N));
+      SF : constant Source_Ptr        := Source_First (SI);
+      SL : constant Source_Ptr        := Source_Last (SI);
+      F  : Node_Id;
+      S  : Source_Ptr;
+
+   begin
+      F := Last_Node (N);
+      S := Sloc (F);
+
+      --  ??? Protect against inconsistency in locations, by returning S
+      --  immediately if not in the expected range, rather than failing with
+      --  a Constraint_Error when accessing Source_Text(SI)(S)
+
+      if S not in SF .. SL then
+         return S;
+      end if;
+
+      --  Skip past an identifier
+
+      while S in SF .. SL - 1
+        and then Source_Text (SI) (S + 1)
+          in
+        '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' | '.' | '_'
+      loop
+         S := S + 1;
+      end loop;
+
+      --  The following circuit attempts at crawling up the tree from the
+      --  Last_Node, adjusting the Sloc value for any parentheses we know
+      --  are present, similarly to what is done in First_Sloc.
+
+      Node_Loop : loop
+         Paren_Loop : for J in 1 .. Paren_Count (F) loop
+
+            --  We don't look more than 12 characters after the current
+            --  location
+
+            Search_Loop : for K in 1 .. 12 loop
+               exit Node_Loop when S = SL;
+
+               if Source_Text (SI) (S + 1) = ')' then
+                  S := S + 1;
+                  exit Search_Loop;
+
+               elsif Source_Text (SI) (S + 1) <= ' ' then
+                  S := S + 1;
+
+               else
+                  exit Search_Loop;
+               end if;
+            end loop Search_Loop;
+         end loop Paren_Loop;
+
+         exit Node_Loop when F = N;
+         F := Parent (F);
+         exit Node_Loop when Nkind (F) not in N_Subexpr;
+      end loop Node_Loop;
+
+      --  Remove any trailing space
+
+      while S in SF + 1 .. SL
+        and then Source_Text (SI) (S) = ' '
+      loop
+         S := S - 1;
+      end loop;
+
+      return S;
+   end Last_Sloc;
+
    -----------------
    -- No_Warnings --
    -----------------
@@ -1858,13 +2063,30 @@ package body Errout is
       procedure Write_Max_Errors;
       --  Write message if max errors reached
 
-      procedure Write_Source_Code_Line (Loc : Source_Ptr);
-      --  Write the source code line corresponding to Loc, as follows:
+      procedure Write_Source_Code_Lines (Span : Source_Span);
+      --  Write the source code line corresponding to Span, as follows when
+      --  Span in on one line:
+      --
+      --  line |  actual code line here with Span somewhere
+      --       |                        ~~~~~^~~~
+      --
+      --  where the caret on the line points to location Span.Ptr, and the
+      --  range Span.First..Span.Last is underlined.
+      --
+      --  or when the span is over multiple lines:
+      --
+      --  line |  beginning of the Span on this line
+      --   ... |     ...
+      --  line>|  actual code line here with Span.Ptr somewhere
+      --   ... |     ...
+      --  line |  end of the Span on this line
+      --
+      --  or when the span is a simple location, as follows:
       --
-      --  line |  actual code line here with Loc somewhere
+      --  line |  actual code line here with Span somewhere
       --       |                             ^ here
       --
-      --  where the carret on the last line points to location Loc.
+      --  where the caret on the line points to location Span.Ptr
 
       -------------------------
       -- Write_Error_Summary --
@@ -2056,17 +2278,25 @@ package body Errout is
          end if;
       end Write_Max_Errors;
 
-      ----------------------------
-      -- Write_Source_Code_Line --
-      ----------------------------
+      -----------------------------
+      -- Write_Source_Code_Lines --
+      -----------------------------
 
-      procedure Write_Source_Code_Line (Loc : Source_Ptr) is
+      procedure Write_Source_Code_Lines (Span : Source_Span) is
 
          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_Line_Marker
+           (Num   : Pos;
+            Mark  : Boolean;
+            Width : Positive);
+         --  Output the line number Num over Width characters, with possibly
+         --  a Mark to denote the line with the main location when reporting
+         --  a span over multiple lines.
+
          -----------
          -- Image --
          -----------
@@ -2087,26 +2317,76 @@ package body Errout is
             return Str;
          end Image;
 
+         -----------------------
+         -- Write_Line_Marker --
+         -----------------------
+
+         procedure Write_Line_Marker
+           (Num   : Pos;
+            Mark  : Boolean;
+            Width : Positive)
+         is
+         begin
+            Write_Str (Image (Positive (Num), Width => Width));
+            Write_Str ((if Mark then ">" else " ") & "|");
+         end Write_Line_Marker;
+
          --  Local variables
 
-         Line    : constant Pos     := Pos (Get_Physical_Line_Number (Loc));
-         Col     : constant Natural := Natural (Get_Column_Number (Loc));
-         Width   : constant         := 5;
+         Loc     : constant Source_Ptr := Span.Ptr;
+         Line    : constant Pos        := Pos (Get_Physical_Line_Number (Loc));
 
-         Buf     : Source_Buffer_Ptr;
-         Cur_Loc : Source_Ptr := Loc;
+         Col     : constant Natural    := Natural (Get_Column_Number (Loc));
 
-      --  Start of processing for Write_Source_Code_Line
+         Fst      : constant Source_Ptr := Span.First;
+         Line_Fst : constant Pos        :=
+           Pos (Get_Physical_Line_Number (Fst));
+         Col_Fst  : constant Natural    :=
+           Natural (Get_Column_Number (Fst));
+         Lst      : constant Source_Ptr := Span.Last;
+         Line_Lst : constant Pos        :=
+           Pos (Get_Physical_Line_Number (Lst));
+         Col_Lst  : constant Natural    :=
+           Natural (Get_Column_Number (Lst));
+
+         Width    : constant := 5;
+         Buf      : Source_Buffer_Ptr;
+         Cur_Loc  : Source_Ptr := Fst;
+         Cur_Line : Pos := Line_Fst;
+
+      --  Start of processing for Write_Source_Code_Lines
 
       begin
          if Loc >= First_Source_Ptr then
             Buf := Source_Text (Get_Source_File_Index (Loc));
 
-            --  First line with the actual source code line
+            --  First line of the span with actual source code
 
-            Write_Str (Image (Positive (Line), Width => Width));
-            Write_Str (" |");
-            Write_Str (String (Buf (Loc - Source_Ptr (Col) + 1  .. Loc - 1)));
+            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)));
+
+            --  Output all the lines in the span
+
+            while Cur_Loc <= Buf'Last
+              and then Cur_Loc < Lst
+            loop
+               Write_Char (Buf (Cur_Loc));
+               Cur_Loc := Cur_Loc + 1;
+
+               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;
+
+            --  Output the rest of the last line of the span
 
             while Cur_Loc <= Buf'Last
               and then Buf (Cur_Loc) /= ASCII.LF
@@ -2117,15 +2397,28 @@ package body Errout is
 
             Write_Eol;
 
-            --  Second line with carret sign pointing to location Loc
+            --  If the span is on one line, output a second line with caret
+            --  sign pointing to location Loc
 
-            Write_Str (String'(1 .. Width => ' '));
-            Write_Str (" |");
-            Write_Str (String'(1 .. Col - 1 => ' '));
-            Write_Str ("^ here");
-            Write_Eol;
+            if Line_Fst = Line_Lst then
+               Write_Str (String'(1 .. Width => ' '));
+               Write_Str (" |");
+               Write_Str (String'(1 .. Col_Fst - 1 => ' '));
+               Write_Str (String'(Col_Fst .. Col - 1 => '~'));
+               Write_Str ("^");
+               Write_Str (String'(Col + 1 .. Col_Lst => '~'));
+
+               --  If the span is really just a location, add the word "here"
+               --  to clarify this is the location for the message.
+
+               if Col_Fst = Col_Lst then
+                  Write_Str (" here");
+               end if;
+
+               Write_Eol;
+            end if;
          end if;
-      end Write_Source_Code_Line;
+      end Write_Source_Code_Lines;
 
       --  Local variables
 
@@ -2217,12 +2510,12 @@ package body Errout is
                           Errors.Table (E).Insertion_Sloc;
                      begin
                         if Loc /= No_Location then
-                           Write_Source_Code_Line (Loc);
+                           Write_Source_Code_Lines (To_Span (Loc));
                         end if;
                      end;
 
                   else
-                     Write_Source_Code_Line (Errors.Table (E).Sptr);
+                     Write_Source_Code_Lines (Errors.Table (E).Sptr);
                   end if;
                end if;
             end if;
@@ -2355,11 +2648,12 @@ package body Errout is
          --  subunits for a body).
 
          while E /= No_Error_Msg
-           and then (not In_Extended_Main_Source_Unit (Errors.Table (E).Sptr)
+           and then (not In_Extended_Main_Source_Unit
+                           (Errors.Table (E).Sptr.Ptr)
                        or else
                         (Debug_Flag_Dot_M
                           and then Get_Source_Unit
-                                     (Errors.Table (E).Sptr) /= Main_Unit))
+                                     (Errors.Table (E).Sptr.Ptr) /= Main_Unit))
          loop
             if Errors.Table (E).Deleted then
                E := Errors.Table (E).Next;
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 02cfdee..f9a8379 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -703,10 +703,15 @@ package Errout is
    procedure Error_Msg
      (Msg : String; Flag_Location : Source_Ptr);
    procedure Error_Msg
+     (Msg : String; Flag_Span : Source_Span);
+   procedure Error_Msg
      (Msg : String; Flag_Location : Source_Ptr; N : Node_Id);
+   procedure Error_Msg
+     (Msg : String; Flag_Span : Source_Span; N : Node_Id);
    --  Output a message at specified location. Can be called from the parser
    --  or the semantic analyzer. If N is set, points to the relevant node for
-   --  this message.
+   --  this message. The version with a span is preferred whenever possible,
+   --  in other cases the version with a location can still be used.
 
    procedure Error_Msg
      (Msg                    : String;
@@ -782,8 +787,13 @@ package Errout is
       N             : Node_Or_Entity_Id;
       E             : Node_Or_Entity_Id;
       Flag_Location : Source_Ptr);
+   procedure Error_Msg_NEL
+     (Msg       : String;
+      N         : Node_Or_Entity_Id;
+      E         : Node_Or_Entity_Id;
+      Flag_Span : Source_Span);
    --  Exactly the same as Error_Msg_NE, except that the flag is placed at
-   --  the specified Flag_Location instead of at Sloc (N).
+   --  the specified Flag_Location/Flag_Span instead of at Sloc (N).
 
    procedure Error_Msg_NW
      (Eflag : Boolean;
@@ -801,12 +811,17 @@ package Errout is
    --  the given text. This text may contain insertion characters in the
    --  usual manner, and need not be the same length as the original text.
 
+   procedure First_And_Last_Nodes
+     (C                     : Node_Id;
+      First_Node, Last_Node : out Node_Id);
+   --  Given a construct C, finds the first and last node in the construct,
+   --  i.e. the ones with the lowest and highest Sloc value. This is useful in
+   --  placing error msgs. Note that this procedure uses Original_Node to look
+   --  at the original source tree, since that's what we want for placing an
+   --  error message flag in the right place.
+
    function First_Node (C : Node_Id) return Node_Id;
-   --  Given a construct C, finds the first node in the construct, i.e. the one
-   --  with the lowest Sloc value. This is useful in placing error msgs. Note
-   --  that this procedure uses Original_Node to look at the original source
-   --  tree, since that's what we want for placing an error message flag in
-   --  the right place.
+   --  Return the first output of First_And_Last_Nodes
 
    function First_Sloc (N : Node_Id) return Source_Ptr;
    --  Given the node for an expression, return a source pointer value that
@@ -817,6 +832,15 @@ package Errout is
    function Get_Ignore_Errors return Boolean;
    --  Return True if all error calls are ignored.
 
+   function Last_Node (C : Node_Id) return Node_Id;
+   --  Return the last output of First_And_Last_Nodes
+
+   function Last_Sloc (N : Node_Id) return Source_Ptr;
+   --  Given the node for an expression, return a source pointer value that
+   --  points to the end of the last token in the expression. In the case
+   --  where the expression is parenthesized, an attempt is made to include
+   --  the parentheses (i.e. to return the location of the final paren).
+
    procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr)
      renames Erroutc.Purge_Messages;
    --  All error messages whose location is in the range From .. To (not
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index d0cc6ff..d7ca221 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -321,7 +321,7 @@ package body Erroutc is
 
       Write_Str
         ("  Sptr     = ");
-      Write_Location (E.Sptr);
+      Write_Location (E.Sptr.Ptr);  --  ??? Do not write the full span for now
       Write_Eol;
 
       Write_Str
@@ -350,7 +350,7 @@ package body Erroutc is
 
    function Get_Location (E : Error_Msg_Id) return Source_Ptr is
    begin
-      return Errors.Table (E).Sptr;
+      return Errors.Table (E).Sptr.Ptr;
    end Get_Location;
 
    ----------------
@@ -477,7 +477,7 @@ package body Erroutc is
         and then Errors.Table (T).Line = Errors.Table (E).Line
         and then Errors.Table (T).Sfile = Errors.Table (E).Sfile
       loop
-         if Errors.Table (T).Sptr > Errors.Table (E).Sptr then
+         if Errors.Table (T).Sptr.Ptr > Errors.Table (E).Sptr.Ptr then
             Mult_Flags := True;
          end if;
 
@@ -490,7 +490,7 @@ package body Erroutc is
 
       if not Debug_Flag_2 then
          Write_Str ("        ");
-         P := Line_Start (Errors.Table (E).Sptr);
+         P := Line_Start (Errors.Table (E).Sptr.Ptr);
          Flag_Num := 1;
 
          --  Loop through error messages for this line to place flags
@@ -507,7 +507,7 @@ package body Erroutc is
             begin
                --  Loop to output blanks till current flag position
 
-               while P < Errors.Table (T).Sptr loop
+               while P < Errors.Table (T).Sptr.Ptr loop
 
                   --  Horizontal tab case, just echo the tab
 
@@ -536,7 +536,7 @@ package body Erroutc is
                --  Output flag (unless already output, this happens if more
                --  than one error message occurs at the same flag position).
 
-               if P = Errors.Table (T).Sptr then
+               if P = Errors.Table (T).Sptr.Ptr then
                   if (Flag_Num = 1 and then not Mult_Flags)
                     or else Flag_Num > 9
                   then
@@ -955,8 +955,8 @@ package body Erroutc is
       function To_Be_Purged (E : Error_Msg_Id) return Boolean is
       begin
          if E /= No_Error_Msg
-           and then Errors.Table (E).Sptr > From
-           and then Errors.Table (E).Sptr < To
+           and then Errors.Table (E).Sptr.Ptr > From
+           and then Errors.Table (E).Sptr.Ptr < To
          then
             if Errors.Table (E).Warn or else Errors.Table (E).Style then
                Warnings_Detected := Warnings_Detected - 1;
diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index 4c0e68a..eb43466 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -197,7 +197,7 @@ package Erroutc is
       --  refers to a template, always references the original template
       --  not an instantiation copy.
 
-      Sptr : Source_Ptr;
+      Sptr : Source_Span;
       --  Flag pointer. In the case of an error that refers to a template,
       --  always references the original template, not an instantiation copy.
       --  This value is the actual place in the source that the error message
diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb
index d4821fc..0a9f6ad 100644
--- a/gcc/ada/errutil.adb
+++ b/gcc/ada/errutil.adb
@@ -207,7 +207,7 @@ package body Errutil is
             Next                => No_Error_Msg,
             Prev                => No_Error_Msg,
             Sfile               => Get_Source_File_Index (Sptr),
-            Sptr                => Sptr,
+            Sptr                => To_Span (Sptr),
             Optr                => Optr,
             Insertion_Sloc      => No_Location,
             Line                => Get_Physical_Line_Number (Sptr),
@@ -234,7 +234,7 @@ package body Errutil is
            Errors.Table (Cur_Msg).Sfile < Errors.Table (Next_Msg).Sfile;
 
          if Errors.Table (Cur_Msg).Sfile = Errors.Table (Next_Msg).Sfile then
-            exit when Sptr < Errors.Table (Next_Msg).Sptr;
+            exit when Sptr < Errors.Table (Next_Msg).Sptr.Ptr;
          end if;
 
          Prev_Msg := Next_Msg;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index da14af9..cbdecaa 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3644,8 +3644,8 @@ package body Freeze is
                  and then not Freezing_Library_Level_Tagged_Type
                then
                   Error_Msg_Node_1 := F_Type;
-                  Error_Msg
-                    ("type & must be fully defined before this point", Loc);
+                  Error_Msg_N
+                    ("type & must be fully defined before this point", N);
                end if;
             end if;
 
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index 78a3ebd..41aad79 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -1379,9 +1379,9 @@ package body Ch3 is
       procedure No_List is
       begin
          if Num_Idents > 1 then
-            Error_Msg
+            Error_Msg_N
               ("identifier list not allowed for RENAMES",
-               Sloc (Idents (2)));
+               Idents (2));
          end if;
 
          List_OK := False;
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 51409f2..d05f267 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -158,7 +158,7 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
    procedure Check_Arg_Count (Required : Int) is
    begin
       if Arg_Count /= Required then
-         Error_Msg ("wrong number of arguments for pragma%", Pragma_Sloc);
+         Error_Msg_N ("wrong number of arguments for pragma%", Pragma_Node);
          raise Error_Resync;
       end if;
    end Check_Arg_Count;
@@ -177,7 +177,7 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
          Error_Msg_Name_2 := Name_On;
          Error_Msg_Name_3 := Name_Off;
 
-         Error_Msg ("argument for pragma% must be% or%", Sloc (Argx));
+         Error_Msg_N ("argument for pragma% must be% or%", Argx);
          raise Error_Resync;
       end if;
    end Check_Arg_Is_On_Or_Off;
@@ -189,9 +189,9 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
    procedure Check_Arg_Is_String_Literal (Arg : Node_Id) is
    begin
       if Nkind (Expression (Arg)) /= N_String_Literal then
-         Error_Msg
+         Error_Msg_N
            ("argument for pragma% must be string literal",
-             Sloc (Expression (Arg)));
+            Expression (Arg));
          raise Error_Resync;
       end if;
    end Check_Arg_Is_String_Literal;
@@ -466,7 +466,7 @@ begin
          A := Expression (Arg1);
 
          if Nkind (A) /= N_Identifier then
-            Error_Msg ("incorrect argument for pragma %", Sloc (A));
+            Error_Msg_N ("incorrect argument for pragma %", A);
          else
             Set_Name_Table_Boolean3 (Chars (A), True);
          end if;
@@ -718,9 +718,9 @@ begin
          begin
             if Prag_Id = Pragma_Source_File_Name then
                if Project_File_In_Use = In_Use then
-                  Error_Msg
+                  Error_Msg_N
                     ("pragma Source_File_Name cannot be used " &
-                     "with a project file", Pragma_Sloc);
+                     "with a project file", Pragma_Node);
 
                else
                   Project_File_In_Use := Not_In_Use;
@@ -728,9 +728,9 @@ begin
 
             else
                if Project_File_In_Use = Not_In_Use then
-                  Error_Msg
+                  Error_Msg_N
                     ("pragma Source_File_Name_Project should only be used " &
-                     "with a project file", Pragma_Sloc);
+                     "with a project file", Pragma_Node);
                else
                   Project_File_In_Use := In_Use;
                end if;
@@ -773,9 +773,9 @@ begin
                     or else Intval (Expr) > 999
                     or else Intval (Expr) <= 0
                   then
-                     Error_Msg
+                     Error_Msg_N
                        ("pragma% index must be integer literal" &
-                        " in range 1 .. 999", Sloc (Expr));
+                        " in range 1 .. 999", Expr);
                      raise Error_Resync;
                   else
                      Index := UI_To_Int (Intval (Expr));
@@ -908,8 +908,8 @@ begin
            and then Num_SRef_Pragmas (Current_Source_File) = 0
            and then Operating_Mode /= Check_Syntax
          then
-            Error_Msg -- CODEFIX
-              ("first % pragma must be first line of file", Pragma_Sloc);
+            Error_Msg_N -- CODEFIX
+              ("first % pragma must be first line of file", Pragma_Node);
             raise Error_Resync;
          end if;
 
@@ -917,9 +917,9 @@ begin
 
          if Arg_Count = 1 then
             if Num_SRef_Pragmas (Current_Source_File) = 0 then
-               Error_Msg
+               Error_Msg_N
                  ("file name required for first % pragma in file",
-                  Pragma_Sloc);
+                  Pragma_Node);
                raise Error_Resync;
             else
                Fname := No_File;
@@ -934,17 +934,17 @@ begin
 
             if Num_SRef_Pragmas (Current_Source_File) > 0 then
                if Fname /= Full_Ref_Name (Current_Source_File) then
-                  Error_Msg
-                    ("file name must be same in all % pragmas", Pragma_Sloc);
+                  Error_Msg_N
+                    ("file name must be same in all % pragmas", Pragma_Node);
                   raise Error_Resync;
                end if;
             end if;
          end if;
 
          if Nkind (Expression (Arg1)) /= N_Integer_Literal then
-            Error_Msg
+            Error_Msg_N
               ("argument for pragma% must be integer literal",
-                Sloc (Expression (Arg1)));
+               Expression (Arg1));
             raise Error_Resync;
 
          --  OK, this source reference pragma is effective, however, we
@@ -1059,7 +1059,7 @@ begin
             end if;
 
             if not OK then
-               Error_Msg ("incorrect argument for pragma%", Sloc (A));
+               Error_Msg_N ("incorrect argument for pragma%", A);
                raise Error_Resync;
             end if;
          end if;
diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb
index 1f26075..0571c0f 100644
--- a/gcc/ada/par-util.adb
+++ b/gcc/ada/par-util.adb
@@ -254,7 +254,7 @@ package body Util is
       then
          return Mark;
       else
-         Error_Msg ("subtype mark expected", Sloc (Mark));
+         Error_Msg_N ("subtype mark expected", Mark);
          return Error;
       end if;
    end Check_Subtype_Mark;
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index 6cda6a9..7f35cfc 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -677,8 +677,6 @@ package body Sem_Case is
       --------------------
 
       procedure Missing_Choice (Value1 : Uint; Value2 : Uint) is
-         Msg_Sloc : constant Source_Ptr := Sloc (Case_Node);
-
       begin
          --  AI05-0188 : within an instance the non-others choices do not have
          --  to belong to the actual subtype.
@@ -704,10 +702,10 @@ package body Sem_Case is
          if Value1 = Value2 then
             if Is_Integer_Type (Bounds_Type) then
                Error_Msg_Uint_1 := Value1;
-               Error_Msg ("missing case value: ^!", Msg_Sloc);
+               Error_Msg_N ("missing case value: ^!", Case_Node);
             else
                Error_Msg_Name_1 := Choice_Image (Value1, Bounds_Type);
-               Error_Msg ("missing case value: %!", Msg_Sloc);
+               Error_Msg_N ("missing case value: %!", Case_Node);
             end if;
 
          --  More than one choice value, so print range of values
@@ -716,11 +714,11 @@ package body Sem_Case is
             if Is_Integer_Type (Bounds_Type) then
                Error_Msg_Uint_1 := Value1;
                Error_Msg_Uint_2 := Value2;
-               Error_Msg ("missing case values: ^ .. ^!", Msg_Sloc);
+               Error_Msg_N ("missing case values: ^ .. ^!", Case_Node);
             else
                Error_Msg_Name_1 := Choice_Image (Value1, Bounds_Type);
                Error_Msg_Name_2 := Choice_Image (Value2, Bounds_Type);
-               Error_Msg ("missing case values: % .. %!", Msg_Sloc);
+               Error_Msg_N ("missing case values: % .. %!", Case_Node);
             end if;
          end if;
       end Missing_Choice;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 4724e0e..07dec4c 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -4147,8 +4147,8 @@ package body Sem_Ch13 is
                         --  Must not be parenthesized
 
                         if Paren_Count (Expr) /= 0 then
-                           Error_Msg -- CODEFIX
-                             ("redundant parentheses", First_Sloc (Expr));
+                           Error_Msg_F -- CODEFIX
+                             ("redundant parentheses", Expr);
                         end if;
 
                         --  List of arguments is list of aggregate expressions
@@ -4442,8 +4442,8 @@ package body Sem_Ch13 is
                   --  parentheses).
 
                   if Paren_Count (Expr) /= 0 then
-                     Error_Msg -- CODEFIX
-                       ("redundant parentheses", First_Sloc (Expr));
+                     Error_Msg_F -- CODEFIX
+                       ("redundant parentheses", Expr);
                      goto Continue;
                   end if;
 
@@ -4860,11 +4860,11 @@ package body Sem_Ch13 is
                      Error_Msg_Name_1 := Aspect_Names (A_Id);
                      Error_Msg_Sloc := Sloc (Inherited_Aspect);
 
-                     Error_Msg
+                     Error_Msg_N
                        ("overriding aspect specification for "
                           & "nonoverridable aspect % does not confirm "
                           & "aspect specification inherited from #",
-                        Sloc (Aspect));
+                        Aspect);
                   end if;
                end;
             end if;
@@ -7909,9 +7909,8 @@ package body Sem_Ch13 is
       --  Check that the expression is a proper aggregate (no parentheses)
 
       elsif Paren_Count (Aggr) /= 0 then
-         Error_Msg
-           ("extra parentheses surrounding aggregate not allowed",
-            First_Sloc (Aggr));
+         Error_Msg_F
+           ("extra parentheses surrounding aggregate not allowed", Aggr);
          return;
 
       --  All tests passed, so set rep clause in place
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 41e1e49..4784397 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1575,9 +1575,8 @@ package body Sem_Ch3 is
 
    begin
       if not RTE_Available (RE_Interface_Tag) then
-         Error_Msg
-           ("(Ada 2005) interface types not supported by this run-time!",
-            Sloc (N));
+         Error_Msg_N
+           ("(Ada 2005) interface types not supported by this run-time!", N);
          return;
       end if;
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 3ef5e82..1b1e01b 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -566,8 +566,8 @@ package body Sem_Prag is
          --  Check that the expression is a proper aggregate (no parentheses)
 
          if Paren_Count (CCases) /= 0 then
-            Error_Msg -- CODEFIX
-              ("redundant parentheses", First_Sloc (CCases));
+            Error_Msg_F -- CODEFIX
+              ("redundant parentheses", CCases);
          end if;
 
          --  Ensure that the formal parameters are visible when analyzing all
@@ -15041,9 +15041,8 @@ package body Sem_Prag is
             else
                --  All other cases: diagnose error
 
-               Error_Msg
-                 ("argument of pragma ""Debug"" is not procedure call",
-                  Sloc (Call));
+               Error_Msg_N
+                 ("argument of pragma ""Debug"" is not procedure call", Call);
                return;
             end if;
 
@@ -25632,9 +25631,9 @@ package body Sem_Prag is
                               Set_Specific_Warning_On (Loc, Message, Err);
 
                               if Err then
-                                 Error_Msg
+                                 Error_Msg_N
                                    ("??pragma Warnings On with no matching "
-                                    & "Warnings Off", Loc);
+                                    & "Warnings Off", N);
                               end if;
                            end if;
                         end;
@@ -29206,8 +29205,8 @@ package body Sem_Prag is
          --  Check that the expression is a proper aggregate (no parentheses)
 
          if Paren_Count (Variants) /= 0 then
-            Error_Msg -- CODEFIX
-              ("redundant parentheses", First_Sloc (Variants));
+            Error_Msg_F -- CODEFIX
+              ("redundant parentheses", Variants);
          end if;
 
          --  Ensure that the formal parameters are visible when analyzing all
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index 175ffb2..408d661 100644
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -218,6 +218,16 @@ package Types is
    --  which source it refers to. Note that negative numbers are allowed to
    --  accommodate the following special values.
 
+   type Source_Span is record
+      Ptr, First, Last : Source_Ptr;
+   end record;
+   --  Type used to represent a source span, consisting in a main location Ptr,
+   --  with a First and Last location, such that Ptr in First .. Last
+
+   function To_Span (Loc : Source_Ptr) return Source_Span is ((others => Loc));
+   function To_Span (Ptr, First, Last : Source_Ptr) return Source_Span is
+     ((Ptr, First, Last));
+
    No_Location : constant Source_Ptr := -1;
    --  Value used to indicate no source position set in a node. A test for a
    --  Source_Ptr value being > No_Location is the approved way to test for a