From: Viljar Indus <indus@adacore.com>
Date: Wed, 8 Apr 2026 11:32:40 +0000 (+0300)
Subject: ada: Support qualified error names from Standard
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=6b8002dbf8bda17c2de45fbde2952ff3bc6de1d2;p=thirdparty%2Fgcc.git

ada: Support qualified error names from Standard

Typically nodes from Standard were not printed without the
fully qualified prefix names even when Error_Msg_Qual_Level was set.
However in some cases it makes sense to emphasize that the variable
is coming from Standard.

Add a new variable called Error_Msg_Qual_For_Standard to enable
qualified names for entities coming from Standard.

gcc/ada/ChangeLog:

	* err_vars.ads (Error_Msg_Qual_For_Standard): New Variable.
	* errout.ads (Error_Msg_Qual_For_Standard): Likewise.
	* errout.adb (Set_Qualification): Print all qualified names
	when Error_Msg_Qual_For_Standard is set.
	* sem_util.adb (Normalize_Actuals): Improve error message.
---

diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads
index 45ff26a4d56..179c65a84cf 100644
--- a/gcc/ada/err_vars.ads
+++ b/gcc/ada/err_vars.ads
@@ -55,6 +55,13 @@ package Err_Vars is
    --  not get reset by any Error_Msg call, so the caller is responsible
    --  for resetting it.
 
+   Error_Msg_Qual_For_Standard : Boolean := False;
+   --  Typically we do not want to specify the Standard package when presenting
+   --  entity names even when Error_Msg_Qual_Level is not zero. However
+   --  sometimes we want to emphasize the fact that it is the entity from
+   --  standard. Note that this value does not get reset by any Error_Msg call,
+   --  so the caller is responsible for resetting it.
+
    Current_Error_Source_File : Source_File_Index := No_Source_File;
    --  Id of current messages. Used to post file name when unit changes. This
    --  is initialized to Main_Source_File at the start of a compilation, which
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index ab5aaf0b737..2c427b7515e 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -4129,7 +4129,10 @@ package body Errout is
 
    procedure Set_Qualification (N : Nat; E : Entity_Id) is
    begin
-      if N /= 0 and then Scope (E) /= Standard_Standard then
+      if N /= 0
+        and then
+          (Scope (E) /= Standard_Standard or else Error_Msg_Qual_For_Standard)
+      then
          Set_Qualification (N - 1, Scope (E));
          Set_Msg_Node (Scope (E));
          Set_Msg_Char ('.');
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index be828d55c69..a9756f6b089 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -483,6 +483,9 @@ package Errout is
    --  not get reset by any Error_Msg call, so the caller is responsible
    --  for resetting it.
 
+   Error_Msg_Qual_For_Standard : Boolean renames
+     Err_Vars.Error_Msg_Qual_For_Standard;
+
    Error_Msg_Warn : Boolean renames Err_Vars.Error_Msg_Warn;
    --  Used if current message contains a < insertion character to indicate
    --  if the current message is a warning message. Must be set appropriately
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 1745accfe59..5698b2f0fef 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -25986,10 +25986,12 @@ package body Sem_Util is
                   if Present (Homonym (S))
                     and then Sloc (Homonym (S)) = Standard_Location
                   then
+                     Error_Msg_Qual_For_Standard := True;
+                     Error_Msg_Qual_Level := 1;
                      Error_Msg_NE
-                       ("\\did you mean & in Standard'?",
-                        Name (N),
-                        Homonym (S));
+                       ("\\did you mean &'?", Name (N), Homonym (S));
+                     Error_Msg_Qual_For_Standard := False;
+                     Error_Msg_Qual_Level := 0;
                   end if;
                else
                   Error_Msg_N ("too many arguments in call to&", Name (N));