ada: Clean up scope depth and related code (tech debt)

The main point of this patch is to remove the special case
for Atree.F_Scope_Depth_Value in the Assert that Field_Present
in Get_Field_Value. Pulling on that thread leads to lots
of related cleanup.

gcc/ada/ChangeLog:

	* atree.adb (Node_Kind_Table): Specify parameter explicitly in
	GNAT.Table instantiations. Use fully qualified references instead
	of relying on use clauses.
	(Get_Field_Value): Remove special case for F_Scope_Depth_Value.
	That is, enable the Field_Present check in that case.
	(It was already enabled for all other fields.) Violations of this
	check were already fixed.
	(Print_Node_Statistics): Sort the output in decreasing order of
	frequencies.
	(Print_Field_Statistics): Likewise (sort).
	* accessibility.adb (Accessibility_Level): Pass Allow_Alt_Model in
	recursive calls. Apparently, an oversight.
	(Innermost_Master_Scope_Depth): Need to special-case the 'Old
	attribute and allocators.
	* einfo-utils.ads (Scope_Depth): Use Scope_Kind_Id to get
	predicate checks.
	(Scope_Depth_Set): Likewise.
	(Scope_Depth_Default_0): Likewise.
	* einfo-utils.adb: As for spec.
	* frontend.adb (Frontend): Remove unnecessary "return;".
	* gen_il-types.ads (Scope_Kind): New union type.
	* gen_il-gen-gen_entities.adb (Scope_Kind): New union type.
	* sem.ads: Move "with Einfo.Entities;" from body to spec.
	(Scope_Stack_Entry): Declare Entity to be of Scope_Kind_Id to get
	predicate checks. We had previously been putting non-scopes on the
	scope stack; this prevents such anomalies.
	* sem.adb: Move "with Einfo.Entities;" from body to spec.
	* sem_ch8.ads: Move "with Einfo.Entities;" from body to spec. Add
	"with Types;".
	(Push_Scope): Use Scope_Kind_Id to get predicate checks.
	* sem_ch8.adb: Move "with Einfo.Entities;" from body to spec. Add
	"with Types;".
	(Push_Scope): Use Scope_Kind_Id to get predicate checks.
	(Pop_Scope): Use Scope_Kind_Id on popped entity to get predicate
	checks. This prevents anomalies where a scope pushed onto the
	stack is later mutated to a nonscope before being popped.
	* sem_util.ads (Find_Enclosing_Scope): Add postcondition to ensure
	that the enclosing scope of a node N is not the same node N.
	Clearly, N does not enclose itself.
	* sem_util.adb (Find_Enclosing_Scope): There were several bugs
	where Find_Enclosing_Scope(N) = N. For example, if N is an entity,
	then we would typically go up to its declaration, and then back
	down to the Defining_Entity of the declaration, which is N itself.
	There were other cases where Find_Enclosing_Scope of an entity
	disagreed with Scope. Clearly, Find_Enclosing_Scope and Scope
	should agree (when both are defined). Such bugs caused latent bugs
	in accessibility.adb related to 'Old, and fixing bugs here caused
	such bugs to be revealed. These are fixed by calling Scope when N
	is an entity.

Co-authored-by: Ronan Desplanques <desplanques@adacore.com>

1 files changed, 24 insertions, 14 deletions

diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index bc897d1..bc217be 100644
--- a/gcc/ada/accessibility.adb
+++ b/gcc/ada/accessibility.adb
@@ -119,8 +119,9 @@ package body Accessibility is
    is
       Loc : constant Source_Ptr := Sloc (Expr);
 
-      function Accessibility_Level (Expr : Node_Id) return Node_Id
-        is (Accessibility_Level (Expr, Level, In_Return_Context));
+      function Accessibility_Level (Expr : Node_Id) return Node_Id is
+        (Accessibility_Level
+          (Expr, Level, In_Return_Context, Allow_Alt_Model));
       --  Renaming of the enclosing function to facilitate recursive calls
 
       function Make_Level_Literal (Level : Uint) return Node_Id;
@@ -164,7 +165,19 @@ package body Accessibility is
             Ent := Defining_Entity_Or_Empty (Node_Par);
 
             if Present (Ent) then
-               Encl_Scop := Find_Enclosing_Scope (Ent);
+               --  X'Old is nested within the current subprogram, so we do not
+               --  want Find_Enclosing_Scope of that subprogram. If this is an
+               --  allocator, then we're looking for the innermost master of
+               --  the call, so again we do not want Find_Enclosing_Scope.
+
+               if (Nkind (N) = N_Attribute_Reference
+                    and then Attribute_Name (N) = Name_Old)
+                 or else Nkind (N) = N_Allocator
+               then
+                  Encl_Scop := Ent;
+               else
+                  Encl_Scop := Find_Enclosing_Scope (Ent);
+               end if;
 
                --  Ignore transient scopes made during expansion while also
                --  taking into account certain expansions - like iterators
@@ -177,17 +190,13 @@ package body Accessibility is
                then
                   --  Note that in some rare cases the scope depth may not be
                   --  set, for example, when we are in the middle of analyzing
-                  --  a type and the enclosing scope is said type. So, instead,
-                  --  continue to move up the parent chain since the scope
-                  --  depth of the type's parent is the same as that of the
-                  --  type.
-
-                  if not Scope_Depth_Set (Encl_Scop) then
-                     pragma Assert (Nkind (Parent (Encl_Scop))
-                                     = N_Full_Type_Declaration);
+                  --  a type and the enclosing scope is said type. In that case
+                  --  simply return zero for the outermost scope.
+
+                  if Scope_Depth_Set (Encl_Scop) then
+                     return Scope_Depth (Encl_Scop) + Master_Lvl_Modifier;
                   else
-                     return
-                       Scope_Depth (Encl_Scop) + Master_Lvl_Modifier;
+                     return Uint_0;
                   end if;
                end if;
 
@@ -424,7 +433,7 @@ package body Accessibility is
          when N_Aggregate =>
             return Make_Level_Literal (Innermost_Master_Scope_Depth (Expr));
 
-         --  The accessibility level is that of the access type, except for an
+         --  The accessibility level is that of the access type, except for
          --  anonymous allocators which have special rules defined in RM 3.10.2
          --  (14/3).
 
@@ -472,6 +481,7 @@ package body Accessibility is
                  and then Present (Get_Dynamic_Accessibility (Entity (Pre)))
                  and then Level = Dynamic_Level
                then
+                  pragma Assert (Is_Anonymous_Access_Type (Etype (Pre)));
                   return New_Occurrence_Of
                            (Get_Dynamic_Accessibility (Entity (Pre)), Loc);