From: Bob Duff <d...@adacore.com>
This patch rewrites Append_Entity_Name, both for maintainability and to
improve user messages. The main issue was that the recursion stopped
when the enclosing scope is the wrapper created in case of
postconditions with 'Old. This caused different results depending
on the enabling/disabling of assertions. Instead of stopping,
we now skip things that the user shouldn't see; there is useful
information in more-outer scope names.
Simplify the code. We had a nested procedure, which called itself
recursively, and also was mutually recursive with the outer procedure.
Avoid testing Is_Internal_Name of the Chars, which seems too fragile.
'R' is used for subprogram instances, but for example "SR" is used for
TSS_Stream_Read, so removing 'R' works only by accident.
Instead, base the test for subprogram instances on normal Einfo
queries.
The new version of Append_Entity_Name produces different (and better)
results in many cases, but this fact is not apparent in most test cases,
because they don't raise unhandled exceptions or do other things that
involve printing the entity name.
The comment:
-- Otherwise nothing to output (happens in unnamed block statements)
is removed; there are many cases other than block statements that
reached that part of the code.
gcc/ada/
* sem_util.ads (Append_Entity_Name): Fix comment to reflect new
semantics. The comment said, "The qualification stops at an
enclosing scope has no source name (block or loop)." There seems
to be no reason for stopping; instead, we should SKIP things with
no source name. And the "loop" part was wrong.
* sem_util.adb (Append_Entity_Name): Do not stop the recursion;
skip to next-outer scope instead. Misc cleanup/simplification.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_util.adb | 128 +++++++++++++++++--------------------------
gcc/ada/sem_util.ads | 7 +--
2 files changed, 54 insertions(+), 81 deletions(-)
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 6350524874c..b30cbcd57e9 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -645,96 +645,70 @@ package body Sem_Util is
-- Append_Entity_Name --
------------------------
- procedure Append_Entity_Name (Buf : in out Bounded_String; E : Entity_Id) is
- Temp : Bounded_String;
-
- procedure Inner (E : Entity_Id);
- -- Inner recursive routine, keep outer routine nonrecursive to ease
- -- debugging when we get strange results from this routine.
-
- -----------
- -- Inner --
- -----------
-
- procedure Inner (E : Entity_Id) is
- Scop : Node_Id;
-
- begin
- -- If entity has an internal name, skip by it, and print its scope.
- -- Note that we strip a final R from the name before the test; this
- -- is needed for some cases of instantiations.
-
- declare
- E_Name : Bounded_String;
-
- begin
- Append (E_Name, Chars (E));
-
- if E_Name.Chars (E_Name.Length) = 'R' then
- E_Name.Length := E_Name.Length - 1;
- end if;
-
- if Is_Internal_Name (E_Name) then
- Inner (Scope (E));
- return;
- end if;
- end;
-
- Scop := Scope (E);
-
- -- Just print entity name if its scope is at the outer level
-
- if Scop = Standard_Standard then
+ procedure Append_Entity_Name
+ (Buf : in out Bounded_String; E : Entity_Id)
+ is
+ Scop : constant Node_Id := Scope (E);
+ -- We recursively print the scope to Buf, and then print the simple
+ -- name, along with some special cases (see below). So for A.B.C.D,
+ -- recursively print A.B.C, then print D.
+ begin
+ -- If E is not a source entity, then skip the simple name and just
+ -- recursively print its scope. However, subprogram instances have
+ -- Comes_From_Source = False, but we do want to print the simple name
+ -- of the instance.
+
+ if not Comes_From_Source (E) then
+ if Is_Generic_Instance (E)
+ and then Ekind (E) in E_Function | E_Procedure
+ then
null;
+ else
+ Append_Entity_Name (Buf, Scope (E));
+ return;
+ end if;
+ end if;
- -- If scope comes from source, write scope and entity
-
- elsif Comes_From_Source (Scop) then
- Append_Entity_Name (Temp, Scop);
- Append (Temp, '.');
-
- -- If in wrapper package skip past it
-
- elsif Present (Scop) and then Is_Wrapper_Package (Scop) then
- Append_Entity_Name (Temp, Scope (Scop));
- Append (Temp, '.');
+ -- Just print entity name if its scope is at the outer level
- -- Otherwise nothing to output (happens in unnamed block statements)
+ if No (Scop) or Scop = Standard_Standard then
+ null;
- else
- null;
- end if;
+ -- If scope comes from source, write scope and entity
- -- Output the name
+ elsif Comes_From_Source (Scop) then
+ Append_Entity_Name (Buf, Scop);
+ Append (Buf, '.');
- declare
- E_Name : Bounded_String;
+ -- Otherwise (non-source scope) skip one level
- begin
- Append_Unqualified_Decoded (E_Name, Chars (E));
+ else
+ Append_Entity_Name (Buf, Scope (Scop));
+ Append (Buf, '.');
+ end if;
- -- Remove trailing upper-case letters from the name (useful for
- -- dealing with some cases of internal names generated in the case
- -- of references from within a generic).
+ -- Print the simple name
- while E_Name.Length > 1
- and then E_Name.Chars (E_Name.Length) in 'A' .. 'Z'
- loop
- E_Name.Length := E_Name.Length - 1;
- end loop;
+ declare
+ E_Name : Bounded_String;
+ begin
+ Append_Unqualified_Decoded (E_Name, Chars (E));
- -- Adjust casing appropriately (gets name from source if possible)
+ -- Remove trailing upper-case letters from the name (useful for
+ -- dealing with some cases of internal names generated in the case
+ -- of references from within a generic).
- Adjust_Name_Case (E_Name, Sloc (E));
- Append (Temp, E_Name);
- end;
- end Inner;
+ while E_Name.Length > 1
+ and then E_Name.Chars (E_Name.Length) in 'A' .. 'Z'
+ loop
+ E_Name.Length := E_Name.Length - 1;
+ end loop;
- -- Start of processing for Append_Entity_Name
+ -- Adjust casing appropriately (gets name from source if possible)
- begin
- Inner (E);
- Append (Buf, Temp);
+ Adjust_Name_Case (E_Name, Sloc (E));
+ Append (Buf, E_Name);
+ end;
end Append_Entity_Name;
---------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 83e824b3838..a5eb1ecd7c1 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -110,10 +110,9 @@ package Sem_Util is
-- because those are the only dynamic cases.
procedure Append_Entity_Name (Buf : in out Bounded_String; E : Entity_Id);
- -- Recursive procedure to construct string for qualified name of enclosing
- -- program unit. The qualification stops at an enclosing scope has no
- -- source name (block or loop). If entity is a subprogram instance, skip
- -- enclosing wrapper package. The name is appended to Buf.
+ -- Construct a user-readable expanded name for E, for printing in messages,
+ -- such as run-time errors for unhandled exceptions. Names created for
+ -- internal use are not included. The name is appended to Buf.
procedure Append_Inherited_Subprogram (S : Entity_Id);
-- If the parent of the operation is declared in the visible part of
--
2.43.2
