ada: Improve location of error messages in instantiations

When flag -gnatdF is used, source code lines are displayed to point
the location of errors. The code of the instantiation was displayed
in case of errors inside generic instances, which was not precise.
Now the code inside the generic is displayed.

gcc/ada/

	* errout.adb (Error_Msg_Internal): Store span for Optr field, and
	adapt to new type of Optr.
	(Finalize. Output_JSON_Message, Remove_Warning_Messages): Adapt to
	new type of Optr.
	(Output_Messages): Use Optr instead of Sptr to display code
	snippet closer to error.
	* erroutc.adb (dmsg): Adapt to new type of Optr.
	* erroutc.ads (Error_Msg_Object): Make Optr a span like Sptr.
	* errutil.adb (Error_Msg): Likewise.

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 19ea155326084d11ddda2eb2d9e53b1c599671a6..dcd21778db314832a3d810a0ed13ad6a58339b3b 100644 (file)
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -1215,7 +1215,7 @@ package body Errout is
           Next                => No_Error_Msg,
           Prev                => No_Error_Msg,
           Sptr                => Span,
-          Optr                => Optr,
+          Optr                => Opan,
           Insertion_Sloc      => (if Has_Insertion_Line then Error_Msg_Sloc
                                   else No_Location),
           Sfile               => Get_Source_File_Index (Sptr),
@@ -1284,7 +1284,7 @@ package body Errout is
                        or else
                           (Sptr = Errors.Table (Last_Error_Msg).Sptr.Ptr
                              and then
-                               Optr > Errors.Table (Last_Error_Msg).Optr))
+                               Optr > Errors.Table (Last_Error_Msg).Optr.Ptr))
          then
             Prev_Msg := Last_Error_Msg;
             Next_Msg := No_Error_Msg;
@@ -1302,7 +1302,8 @@ package body Errout is
                then
                   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);
+                              and then
+                             Optr < Errors.Table (Next_Msg).Optr.Ptr);
                end if;
 
                Prev_Msg := Next_Msg;
@@ -1681,8 +1682,8 @@ package body Errout is
                    (Warning_Specifically_Suppressed (CE.Sptr.Ptr, CE.Text, Tag)
                                                                 /= No_String
                       or else
-                    Warning_Specifically_Suppressed (CE.Optr, CE.Text, Tag) /=
-                                                                   No_String)
+                    Warning_Specifically_Suppressed (CE.Optr.Ptr, CE.Text, Tag)
+                                                                /= No_String)
             then
                Delete_Warning (Cur);
 
@@ -2232,9 +2233,9 @@ package body Errout is
       Write_Str (",""locations"":[");
       Write_JSON_Span (Errors.Table (E));
 
-      if Errors.Table (E).Optr /= Errors.Table (E).Sptr.Ptr then
+      if Errors.Table (E).Optr.Ptr /= Errors.Table (E).Sptr.Ptr then
          Write_Str (",{""caret"":");
-         Write_JSON_Location (Errors.Table (E).Optr);
+         Write_JSON_Location (Errors.Table (E).Optr.Ptr);
          Write_Str ("}");
       end if;
 
@@ -2954,7 +2955,7 @@ package body Errout is
                            else SGR_Error);
                      begin
                         Write_Source_Code_Lines
-                          (Errors.Table (E).Sptr, SGR_Span);
+                          (Errors.Table (E).Optr, SGR_Span);
                      end;
                   end if;
                end if;
@@ -3329,7 +3330,7 @@ package body Errout is
 
                --  Don't remove if location does not match
 
-               and then Errors.Table (E).Optr = Loc
+               and then Errors.Table (E).Optr.Ptr = Loc
 
                --  Don't remove if not warning/info message. Note that we do
                --  not remove style messages here. They are warning messages

diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 9ecc97fb46ddd5c6fdfcf2eb24c0152bfb0694c4..7766c9727308c471c217764af0a7f35093d14408 100644 (file)
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -324,7 +324,7 @@ package body Erroutc is
 
       Write_Str
         ("  Optr     = ");
-      Write_Location (E.Optr);
+      Write_Location (E.Optr.Ptr);
       Write_Eol;
 
       w ("  Line     = ", Int (E.Line));

diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index 7957228a91b8a217309748740bc018926991f507..c992bbaa1834a99f65529addbe8b3eaffcdb2a07 100644 (file)
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -209,7 +209,7 @@ package Erroutc is
       --  will be posted. Note that an error placed on an instantiation will
       --  have Sptr pointing to the instantiation point.
 
-      Optr : Source_Ptr;
+      Optr : Source_Span;
       --  Flag location used in the call to post the error. This is the same as
       --  Sptr, except when an error is posted on a particular instantiation of
       --  a generic. In such a case, Sptr will point to the original source

diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb
index 921de319f39713100ef0821ecfcc86fc5a4f9226..887dc8826bf4b304ddafe90429a31b2b8f52cf1f 100644 (file)
--- a/gcc/ada/errutil.adb
+++ b/gcc/ada/errutil.adb
@@ -208,7 +208,7 @@ package body Errutil is
             Prev                => No_Error_Msg,
             Sfile               => Get_Source_File_Index (Sptr),
             Sptr                => To_Span (Sptr),
-            Optr                => Optr,
+            Optr                => To_Span (Optr),
             Insertion_Sloc      => No_Location,
             Line                => Get_Physical_Line_Number (Sptr),
             Col                 => Get_Column_Number (Sptr),