public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-4508] ada: Accessibility code reorganization and bug fixes
@ 2022-12-06 14:00 Marc Poulhi?s
  0 siblings, 0 replies; only message in thread
From: Marc Poulhi?s @ 2022-12-06 14:00 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:f459afaa679956df1f3c0243a87583e4d4b43a2e

commit r13-4508-gf459afaa679956df1f3c0243a87583e4d4b43a2e
Author: Justin Squirek <squirek@adacore.com>
Date:   Thu Nov 17 15:34:57 2022 +0000

    ada: Accessibility code reorganization and bug fixes
    
    This patch performs a large reorganization of accessibility related sources,
    and also corrects some latent issues with accessibility checks - namely the
    calculation of accessibility levels for expanded iterators and type
    conversions.
    
    gcc/ada/
            * accessibility.adb, accessibility.ads
            (Accessibility_Message): Moved from sem_attr.
            (Apply_Accessibility_Check): Moved from checks.
            (Apply_Accessibility_Check_For_Allocator): Moved from exp_ch4 and
            renamed
            (Check_Return_Construct_Accessibility): Moved from sem_ch6.
            (Innermost_Master_Scope_Depth): Moved from sem_util. Add condition
            to detect expanded iterators.
            (Prefix_With_Safe_Accessibility_Level): Moved from sem_attr.
            (Static_Accessibility_Level): Moved from sem_util.
            (Has_Unconstrained_Access_Discriminants): Likewise.
            (Has_Anonymous_Access_Discriminant): Likewise.
            (Is_Anonymous_Access_Actual): Likewise.
            (Is_Special_Aliased_Formal_Access): Likewise.
            (Needs_Result_Accessibility_Level): Likewise.
            (Subprogram_Access_Level): Likewise.
            (Type_Access_Level): Likewise.
            (Deepest_Type_Access_Level): Likewise.
            (Effective_Extra_Accessibility): Likewise.
            (Get_Dynamic_Accessibility): Likewise.
            (Has_Access_Values): Likewise.
            (Accessibility_Level): Likewise.
            * exp_attr.adb (Access_Cases): Obtain the proper enclosing object
            which applies to a given 'Access by looking through type
            conversions.
            * exp_ch4.adb (Apply_Accessibility_Check): Moved to accessibility.
            * exp_ch5.adb: Likewise.
            * exp_ch6.adb: Likewise.
            * exp_ch9.adb: Likewise.
            * exp_disp.adb: Likewise.
            * gen_il-fields.ads: Add new flag Comes_From_Iterator.
            * gen_il-gen-gen_nodes.adb: Add new flag Comes_From_Iterator for
            N_Object_Renaming_Declaration.
            * sem_ch5.adb (Analyze_Iterator_Specification): Mark object
            renamings resulting from iterator expansion with the new flag
            Comes_From_Iterator.
            * sem_aggr.adb (Resolve_Container_Aggregate): Refine test.
            * sem_ch13.adb: Add dependence on the accessibility package.
            * sem_ch3.adb: Likewise.
            * sem_ch4.adb: Likewise.
            * sem_ch9.adb: Likewise.
            * sem_res.adb: Likewise.
            * sem_warn.adb: Likewise.
            * exp_ch3.adb: Likewise.
            * sem_attr.adb (Accessibility_Message): Moved to accessibility.
            (Prefix_With_Safe_Accessibility_Level): Likewise.
            * checks.adb, checks.ads (Apply_Accessibility_Check): Likewise.
            * sem_ch6.adb (Check_Return_Construct_Accessibility): Likewise.
            * sem_util.adb, sem_util.ads
            (Accessibility_Level): Likewise.
            (Deepest_Type_Access_Level): Likewise.
            (Effective_Extra_Accessibility): Likewise.
            (Get_Dynamic_Accessibility): Likewise.
            (Has_Access_Values): Likewise.
            (Has_Anonymous_Access_Discriminant): Likewise.
            (Static_Accessibility_Level): Likewise.
            (Has_Unconstrained_Access_Discriminants): Likewise.
            (Is_Anonymous_Access_Actual): Likewise.
            (Is_Special_Aliased_Formal_Access): Likewise.
            (Needs_Result_Accessibility_Level): Likewise.
            (Subprogram_Access_Level): Likewise.
            (Type_Access_Level): Likewise.
            * sinfo.ads: Document new flag Comes_From_Iterator.
            * gcc-interface/Make-lang.in: Add entry for new Accessibility package.

Diff:
---
 gcc/ada/accessibility.adb          | 2305 ++++++++++++++++++++++++++++++++++++
 gcc/ada/accessibility.ads          |  222 ++++
 gcc/ada/checks.adb                 |  113 --
 gcc/ada/checks.ads                 |   10 -
 gcc/ada/exp_attr.adb               |   15 +-
 gcc/ada/exp_ch3.adb                |    1 +
 gcc/ada/exp_ch4.adb                |  223 +---
 gcc/ada/exp_ch5.adb                |    1 +
 gcc/ada/exp_ch6.adb                |    1 +
 gcc/ada/exp_ch9.adb                |    1 +
 gcc/ada/exp_disp.adb               |    1 +
 gcc/ada/gcc-interface/Make-lang.in |    1 +
 gcc/ada/gen_il-fields.ads          |    1 +
 gcc/ada/gen_il-gen-gen_nodes.adb   |    1 +
 gcc/ada/sem_aggr.adb               |    2 +-
 gcc/ada/sem_attr.adb               |  133 +--
 gcc/ada/sem_ch13.adb               |    1 +
 gcc/ada/sem_ch3.adb                |    1 +
 gcc/ada/sem_ch4.adb                |    1 +
 gcc/ada/sem_ch5.adb                |    1 +
 gcc/ada/sem_ch6.adb                |  519 +-------
 gcc/ada/sem_ch9.adb                |    1 +
 gcc/ada/sem_res.adb                |    1 +
 gcc/ada/sem_util.adb               | 1315 +-------------------
 gcc/ada/sem_util.ads               |  130 --
 gcc/ada/sem_warn.adb               |    1 +
 gcc/ada/sinfo.ads                  |    5 +
 27 files changed, 2585 insertions(+), 2422 deletions(-)

diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
new file mode 100644
index 00000000000..3162806c38f
--- /dev/null
+++ b/gcc/ada/accessibility.adb
@@ -0,0 +1,2305 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                        A C C E S S I B I L I T Y                         --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 2022-2022, Free Software Foundation, Inc.         --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Atree;          use Atree;
+with Checks;         use Checks;
+with Debug;          use Debug;
+with Einfo;          use Einfo;
+with Einfo.Entities; use Einfo.Entities;
+with Elists;         use Elists;
+with Errout;         use Errout;
+with Einfo.Utils;    use Einfo.Utils;
+with Exp_Atag;       use Exp_Atag;
+with Exp_Ch3;        use Exp_Ch3;
+with Exp_Ch7;        use Exp_Ch7;
+with Exp_Tss;        use Exp_Tss;
+with Exp_Util;       use Exp_Util;
+with Namet;          use Namet;
+with Nlists;         use Nlists;
+with Nmake;          use Nmake;
+with Opt;            use Opt;
+with Restrict;       use Restrict;
+with Rtsfind;        use Rtsfind;
+with Sem;            use Sem;
+with Sem_Aux;        use Sem_Aux;
+with Sem_Ch8;        use Sem_Ch8;
+with Sem_Res;        use Sem_Res;
+with Sem_Util;       use Sem_Util;
+with Sinfo;          use Sinfo;
+with Sinfo.Nodes;    use Sinfo.Nodes;
+with Sinfo.Utils;    use Sinfo.Utils;
+with Snames;         use Snames;
+with Stand;          use Stand;
+with Tbuild;         use Tbuild;
+
+package body Accessibility is
+
+   ---------------------------
+   -- Accessibility_Message --
+   ---------------------------
+
+   procedure Accessibility_Message (N : Node_Id; Typ : Entity_Id) is
+      Loc   : constant Source_Ptr := Sloc (N);
+      P     : constant Node_Id    := Prefix (N);
+      Indic : Node_Id             := Parent (Parent (N));
+
+   begin
+      --  In an instance, this is a runtime check, but one we know will fail,
+      --  so generate an appropriate warning.
+
+      if In_Instance_Body then
+         Error_Msg_Warn := SPARK_Mode /= On;
+         Error_Msg_F
+           ("non-local pointer cannot point to local object<<", P);
+         Error_Msg_F ("\Program_Error [<<", P);
+         Rewrite (N,
+           Make_Raise_Program_Error (Loc,
+             Reason => PE_Accessibility_Check_Failed));
+         Set_Etype (N, Typ);
+         return;
+
+      else
+         Error_Msg_F ("non-local pointer cannot point to local object", P);
+
+         --  Check for case where we have a missing access definition
+
+         if Is_Record_Type (Current_Scope)
+           and then
+             Nkind (Parent (N)) in N_Discriminant_Association
+                                 | N_Index_Or_Discriminant_Constraint
+         then
+            Indic := Parent (Parent (N));
+            while Present (Indic)
+              and then Nkind (Indic) /= N_Subtype_Indication
+            loop
+               Indic := Parent (Indic);
+            end loop;
+
+            if Present (Indic) then
+               Error_Msg_NE
+                 ("\use an access definition for" &
+                  " the access discriminant of&",
+                  N, Entity (Subtype_Mark (Indic)));
+            end if;
+         end if;
+      end if;
+   end Accessibility_Message;
+
+   -------------------------
+   -- Accessibility_Level --
+   -------------------------
+
+   function Accessibility_Level
+     (Expr              : Node_Id;
+      Level             : Accessibility_Level_Kind;
+      In_Return_Context : Boolean := False;
+      Allow_Alt_Model   : Boolean := True) return Node_Id
+   is
+      Loc : constant Source_Ptr := Sloc (Expr);
+
+      function Accessibility_Level (Expr : Node_Id) return Node_Id
+        is (Accessibility_Level (Expr, Level, In_Return_Context));
+      --  Renaming of the enclosing function to facilitate recursive calls
+
+      function Make_Level_Literal (Level : Uint) return Node_Id;
+      --  Construct an integer literal representing an accessibility level with
+      --  its type set to Natural.
+
+      function Innermost_Master_Scope_Depth (N : Node_Id) return Uint;
+      --  Returns the scope depth of the given node's innermost enclosing scope
+      --  (effectively the accessibility level of the innermost enclosing
+      --  master).
+
+      function Function_Call_Or_Allocator_Level (N : Node_Id) return Node_Id;
+      --  Centralized processing of subprogram calls which may appear in prefix
+      --  notation.
+
+      function Typ_Access_Level (Typ : Entity_Id) return Uint
+        is (Type_Access_Level (Typ, Allow_Alt_Model));
+      --  Renaming of Type_Access_Level with Allow_Alt_Model specified to avoid
+      --  passing the parameter specifically in every call.
+
+      ----------------------------------
+      -- Innermost_Master_Scope_Depth --
+      ----------------------------------
+
+      function Innermost_Master_Scope_Depth (N : Node_Id) return Uint is
+         Encl_Scop           : Entity_Id;
+         Ent                 : Entity_Id;
+         Node_Par            : Node_Id := Parent (N);
+         Master_Lvl_Modifier : Int     := 0;
+
+      begin
+         --  Locate the nearest enclosing node (by traversing Parents)
+         --  that Defining_Entity can be applied to, and return the
+         --  depth of that entity's nearest enclosing scope.
+
+         --  The RM 7.6.1(3) definition of "master" includes statements
+         --  and conditions for loops among other things. Are these cases
+         --  detected properly ???
+
+         while Present (Node_Par) loop
+            Ent := Defining_Entity_Or_Empty (Node_Par);
+
+            if Present (Ent) then
+               Encl_Scop := Find_Enclosing_Scope (Ent);
+
+               --  Ignore transient scopes made during expansion while also
+               --  taking into account certain expansions - like iterators
+               --  which get expanded into renamings and thus not marked
+               --  as coming from source.
+
+               if Comes_From_Source (Node_Par)
+                 or else (Nkind (Node_Par) = N_Object_Renaming_Declaration
+                           and then Comes_From_Iterator (Node_Par))
+               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);
+                  else
+                     return
+                       Scope_Depth (Encl_Scop) + Master_Lvl_Modifier;
+                  end if;
+               end if;
+
+            --  For a return statement within a function, return
+            --  the depth of the function itself. This is not just
+            --  a small optimization, but matters when analyzing
+            --  the expression in an expression function before
+            --  the body is created.
+
+            elsif Nkind (Node_Par) in N_Extended_Return_Statement
+                                    | N_Simple_Return_Statement
+            then
+               return Scope_Depth (Enclosing_Subprogram (Node_Par));
+
+            --  Statements are counted as masters
+
+            elsif Is_Master (Node_Par) then
+               Master_Lvl_Modifier := Master_Lvl_Modifier + 1;
+
+            end if;
+
+            Node_Par := Parent (Node_Par);
+         end loop;
+
+         --  Should never reach the following return
+
+         pragma Assert (False);
+
+         return Scope_Depth (Current_Scope) + 1;
+      end Innermost_Master_Scope_Depth;
+
+      ------------------------
+      -- Make_Level_Literal --
+      ------------------------
+
+      function Make_Level_Literal (Level : Uint) return Node_Id is
+         Result : constant Node_Id := Make_Integer_Literal (Loc, Level);
+
+      begin
+         Set_Etype (Result, Standard_Natural);
+         return Result;
+      end Make_Level_Literal;
+
+      --------------------------------------
+      -- Function_Call_Or_Allocator_Level --
+      --------------------------------------
+
+      function Function_Call_Or_Allocator_Level (N : Node_Id) return Node_Id is
+         Par      : Node_Id;
+         Prev_Par : Node_Id;
+      begin
+         --  Results of functions are objects, so we either get the
+         --  accessibility of the function or, in case of a call which is
+         --  indirect, the level of the access-to-subprogram type.
+
+         --  This code looks wrong ???
+
+         if Nkind (N) = N_Function_Call
+           and then Ada_Version < Ada_2005
+         then
+            if Is_Entity_Name (Name (N)) then
+               return Make_Level_Literal
+                        (Subprogram_Access_Level (Entity (Name (N))));
+            else
+               return Make_Level_Literal
+                        (Typ_Access_Level (Etype (Prefix (Name (N)))));
+            end if;
+
+         --  We ignore coextensions as they cannot be implemented under the
+         --  "small-integer" model.
+
+         elsif Nkind (N) = N_Allocator
+           and then (Is_Static_Coextension (N)
+                      or else Is_Dynamic_Coextension (N))
+         then
+            return Make_Level_Literal (Scope_Depth (Standard_Standard));
+         end if;
+
+         --  Named access types have a designated level
+
+         if Is_Named_Access_Type (Etype (N)) then
+            return Make_Level_Literal (Typ_Access_Level (Etype (N)));
+
+         --  Otherwise, the level is dictated by RM 3.10.2 (10.7/3)
+
+         else
+            --  Check No_Dynamic_Accessibility_Checks restriction override for
+            --  alternative accessibility model.
+
+            if Allow_Alt_Model
+              and then No_Dynamic_Accessibility_Checks_Enabled (N)
+              and then Is_Anonymous_Access_Type (Etype (N))
+            then
+               --  In the alternative model the level is that of the
+               --  designated type.
+
+               if Debug_Flag_Underscore_B then
+                  return Make_Level_Literal (Typ_Access_Level (Etype (N)));
+
+               --  For function calls the level is that of the innermost
+               --  master, otherwise (for allocators etc.) we get the level
+               --  of the corresponding anonymous access type, which is
+               --  calculated through the normal path of execution.
+
+               elsif Nkind (N) = N_Function_Call then
+                  return Make_Level_Literal
+                           (Innermost_Master_Scope_Depth (Expr));
+               end if;
+            end if;
+
+            if Nkind (N) = N_Function_Call then
+               --  Dynamic checks are generated when we are within a return
+               --  value or we are in a function call within an anonymous
+               --  access discriminant constraint of a return object (signified
+               --  by In_Return_Context) on the side of the callee.
+
+               --  So, in this case, return accessibility level of the
+               --  enclosing subprogram.
+
+               if In_Return_Value (N)
+                 or else In_Return_Context
+               then
+                  return Make_Level_Literal
+                           (Subprogram_Access_Level (Current_Subprogram));
+               end if;
+            end if;
+
+            --  When the call is being dereferenced the level is that of the
+            --  enclosing master of the dereferenced call.
+
+            if Nkind (Parent (N)) in N_Explicit_Dereference
+                                   | N_Indexed_Component
+                                   | N_Selected_Component
+            then
+               return Make_Level_Literal
+                        (Innermost_Master_Scope_Depth (Expr));
+            end if;
+
+            --  Find any relevant enclosing parent nodes that designate an
+            --  object being initialized.
+
+            --  Note: The above is only relevant if the result is used "in its
+            --  entirety" as RM 3.10.2 (10.2/3) states. However, this is
+            --  accounted for in the case statement in the main body of
+            --  Accessibility_Level for N_Selected_Component.
+
+            Par      := Parent (Expr);
+            Prev_Par := Empty;
+            while Present (Par) loop
+               --  Detect an expanded implicit conversion, typically this
+               --  occurs on implicitly converted actuals in calls.
+
+               --  Does this catch all implicit conversions ???
+
+               if Nkind (Par) = N_Type_Conversion
+                 and then Is_Named_Access_Type (Etype (Par))
+               then
+                  return Make_Level_Literal
+                           (Typ_Access_Level (Etype (Par)));
+               end if;
+
+               --  Jump out when we hit an object declaration or the right-hand
+               --  side of an assignment, or a construct such as an aggregate
+               --  subtype indication which would be the result is not used
+               --  "in its entirety."
+
+               exit when Nkind (Par) in N_Object_Declaration
+                           or else (Nkind (Par) = N_Assignment_Statement
+                                     and then Name (Par) /= Prev_Par);
+
+               Prev_Par := Par;
+               Par      := Parent (Par);
+            end loop;
+
+            --  Assignment statements are handled in a similar way in
+            --  accordance to the left-hand part. However, strictly speaking,
+            --  this is illegal according to the RM, but this change is needed
+            --  to pass an ACATS C-test and is useful in general ???
+
+            case Nkind (Par) is
+               when N_Object_Declaration =>
+                  return Make_Level_Literal
+                           (Scope_Depth
+                             (Scope (Defining_Identifier (Par))));
+
+               when N_Assignment_Statement =>
+                  --  Return the accessibility level of the left-hand part
+
+                  return Accessibility_Level
+                           (Expr              => Name (Par),
+                            Level             => Object_Decl_Level,
+                            In_Return_Context => In_Return_Context);
+
+               when others =>
+                  return Make_Level_Literal
+                           (Innermost_Master_Scope_Depth (Expr));
+            end case;
+         end if;
+      end Function_Call_Or_Allocator_Level;
+
+      --  Local variables
+
+      E   : Node_Id := Original_Node (Expr);
+      Pre : Node_Id;
+
+   --  Start of processing for Accessibility_Level
+
+   begin
+      --  We could be looking at a reference to a formal due to the expansion
+      --  of entries and other cases, so obtain the renaming if necessary.
+
+      if Present (Param_Entity (Expr)) then
+         E := Param_Entity (Expr);
+      end if;
+
+      --  Extract the entity
+
+      if Nkind (E) in N_Has_Entity and then Present (Entity (E)) then
+         E := Entity (E);
+
+         --  Deal with a possible renaming of a private protected component
+
+         if Ekind (E) in E_Constant | E_Variable and then Is_Prival (E) then
+            E := Prival_Link (E);
+         end if;
+      end if;
+
+      --  Perform the processing on the expression
+
+      case Nkind (E) is
+         --  The level of an aggregate is that of the innermost master that
+         --  evaluates it as defined in RM 3.10.2 (10/4).
+
+         when N_Aggregate =>
+            return Make_Level_Literal (Innermost_Master_Scope_Depth (Expr));
+
+         --  The accessibility level is that of the access type, except for an
+         --  anonymous allocators which have special rules defined in RM 3.10.2
+         --  (14/3).
+
+         when N_Allocator =>
+            return Function_Call_Or_Allocator_Level (E);
+
+         --  We could reach this point for two reasons. Either the expression
+         --  applies to a special attribute ('Loop_Entry, 'Result, or 'Old), or
+         --  we are looking at the access attributes directly ('Access,
+         --  'Address, or 'Unchecked_Access).
+
+         when N_Attribute_Reference =>
+            Pre := Original_Node (Prefix (E));
+
+            --  Regular 'Access attribute presence means we have to look at the
+            --  prefix.
+
+            if Attribute_Name (E) = Name_Access then
+               return Accessibility_Level (Prefix (E));
+
+            --  Unchecked or unrestricted attributes have unlimited depth
+
+            elsif Attribute_Name (E) in Name_Address
+                                      | Name_Unchecked_Access
+                                      | Name_Unrestricted_Access
+            then
+               return Make_Level_Literal (Scope_Depth (Standard_Standard));
+
+            --  'Access can be taken further against other special attributes,
+            --  so handle these cases explicitly.
+
+            elsif Attribute_Name (E)
+                    in Name_Old | Name_Loop_Entry | Name_Result
+            then
+               --  Named access types
+
+               if Is_Named_Access_Type (Etype (Pre)) then
+                  return Make_Level_Literal
+                           (Typ_Access_Level (Etype (Pre)));
+
+               --  Anonymous access types
+
+               elsif Nkind (Pre) in N_Has_Entity
+                 and then Ekind (Entity (Pre)) not in Subprogram_Kind
+                 and then Present (Get_Dynamic_Accessibility (Entity (Pre)))
+                 and then Level = Dynamic_Level
+               then
+                  return New_Occurrence_Of
+                           (Get_Dynamic_Accessibility (Entity (Pre)), Loc);
+
+               --  Otherwise the level is treated in a similar way as
+               --  aggregates according to RM 6.1.1 (35.1/4) which concerns
+               --  an implicit constant declaration - in turn defining the
+               --  accessibility level to be that of the implicit constant
+               --  declaration.
+
+               else
+                  return Make_Level_Literal
+                           (Innermost_Master_Scope_Depth (Expr));
+               end if;
+
+            else
+               raise Program_Error;
+            end if;
+
+         --  This is the "base case" for accessibility level calculations which
+         --  means we are near the end of our recursive traversal.
+
+         when N_Defining_Identifier =>
+            --  A dynamic check is performed on the side of the callee when we
+            --  are within a return statement, so return a library-level
+            --  accessibility level to null out checks on the side of the
+            --  caller.
+
+            if Is_Explicitly_Aliased (E)
+              and then (In_Return_Context
+                         or else (Level /= Dynamic_Level
+                                   and then In_Return_Value (Expr)))
+            then
+               return Make_Level_Literal (Scope_Depth (Standard_Standard));
+
+            --  Something went wrong and an extra accessibility formal has not
+            --  been generated when one should have ???
+
+            elsif Is_Formal (E)
+              and then No (Get_Dynamic_Accessibility (E))
+              and then Ekind (Etype (E)) = E_Anonymous_Access_Type
+            then
+               return Make_Level_Literal (Scope_Depth (Standard_Standard));
+
+            --  Stand-alone object of an anonymous access type "SAOAAT"
+
+            elsif (Is_Formal (E)
+                    or else Ekind (E) in E_Variable
+                                       | E_Constant)
+              and then Present (Get_Dynamic_Accessibility (E))
+              and then (Level = Dynamic_Level
+                         or else Level = Zero_On_Dynamic_Level)
+            then
+               if Level = Zero_On_Dynamic_Level then
+                  return Make_Level_Literal
+                           (Scope_Depth (Standard_Standard));
+               end if;
+
+               --  No_Dynamic_Accessibility_Checks restriction override for
+               --  alternative accessibility model.
+
+               if Allow_Alt_Model
+                 and then No_Dynamic_Accessibility_Checks_Enabled (E)
+               then
+                  --  In the alternative model the level is that of the
+                  --  designated type entity's context.
+
+                  if Debug_Flag_Underscore_B then
+                     return Make_Level_Literal (Typ_Access_Level (Etype (E)));
+
+                  --  Otherwise the level depends on the entity's context
+
+                  elsif Is_Formal (E) then
+                     return Make_Level_Literal
+                              (Subprogram_Access_Level
+                                (Enclosing_Subprogram (E)));
+                  else
+                     return Make_Level_Literal
+                              (Scope_Depth (Enclosing_Dynamic_Scope (E)));
+                  end if;
+               end if;
+
+               --  Return the dynamic level in the normal case
+
+               return New_Occurrence_Of
+                        (Get_Dynamic_Accessibility (E), Loc);
+
+            --  Initialization procedures have a special extra accessibility
+            --  parameter associated with the level at which the object
+            --  being initialized exists
+
+            elsif Ekind (E) = E_Record_Type
+              and then Is_Limited_Record (E)
+              and then Current_Scope = Init_Proc (E)
+              and then Present (Init_Proc_Level_Formal (Current_Scope))
+            then
+               return New_Occurrence_Of
+                        (Init_Proc_Level_Formal (Current_Scope), Loc);
+
+            --  Current instance of the type is deeper than that of the type
+            --  according to RM 3.10.2 (21).
+
+            elsif Is_Type (E) then
+               --  When restriction No_Dynamic_Accessibility_Checks is active
+               --  along with -gnatd_b.
+
+               if Allow_Alt_Model
+                 and then No_Dynamic_Accessibility_Checks_Enabled (E)
+                 and then Debug_Flag_Underscore_B
+               then
+                  return Make_Level_Literal (Typ_Access_Level (E));
+               end if;
+
+               --  Normal path
+
+               return Make_Level_Literal (Typ_Access_Level (E) + 1);
+
+            --  Move up the renamed entity or object if it came from source
+            --  since expansion may have created a dummy renaming under
+            --  certain circumstances.
+
+            --  Note: We check if the original node of the renaming comes
+            --  from source because the node may have been rewritten.
+
+            elsif Present (Renamed_Entity_Or_Object (E))
+              and then Comes_From_Source
+                (Original_Node (Renamed_Entity_Or_Object (E)))
+            then
+               return Accessibility_Level (Renamed_Entity_Or_Object (E));
+
+            --  Named access types get their level from their associated type
+
+            elsif Is_Named_Access_Type (Etype (E)) then
+               return Make_Level_Literal
+                        (Typ_Access_Level (Etype (E)));
+
+            --  Check if E is an expansion-generated renaming of an iterator
+            --  by examining Related_Expression. If so, determine the
+            --  accessibility level based on the original expression.
+
+            elsif Ekind (E) in E_Constant | E_Variable
+              and then Present (Related_Expression (E))
+            then
+               return Accessibility_Level (Related_Expression (E));
+
+            elsif Level = Dynamic_Level
+               and then Ekind (E) in E_In_Parameter | E_In_Out_Parameter
+               and then Present (Init_Proc_Level_Formal (Scope (E)))
+            then
+               return New_Occurrence_Of
+                        (Init_Proc_Level_Formal (Scope (E)), Loc);
+
+            --  Normal object - get the level of the enclosing scope
+
+            else
+               return Make_Level_Literal
+                        (Scope_Depth (Enclosing_Dynamic_Scope (E)));
+            end if;
+
+         --  Handle indexed and selected components including the special cases
+         --  whereby there is an implicit dereference, a component of a
+         --  composite type, or a function call in prefix notation.
+
+         --  We don't handle function calls in prefix notation correctly ???
+
+         when N_Indexed_Component | N_Selected_Component | N_Slice =>
+            Pre := Prefix (E);
+
+            --  Fetch the original node when the prefix comes from the result
+            --  of expanding a function call since we want to find the level
+            --  of the original source call.
+
+            if not Comes_From_Source (Pre)
+              and then Nkind (Original_Node (Pre)) = N_Function_Call
+            then
+               Pre := Original_Node (Pre);
+            end if;
+
+            --  When E is an indexed component or selected component and
+            --  the current Expr is a function call, we know that we are
+            --  looking at an expanded call in prefix notation.
+
+            if Nkind (Expr) = N_Function_Call then
+               return Function_Call_Or_Allocator_Level (Expr);
+
+            --  If the prefix is a named access type, then we are dealing
+            --  with an implicit deferences. In that case the level is that
+            --  of the named access type in the prefix.
+
+            elsif Is_Named_Access_Type (Etype (Pre)) then
+               return Make_Level_Literal
+                        (Typ_Access_Level (Etype (Pre)));
+
+            --  The current expression is a named access type, so there is no
+            --  reason to look at the prefix. Instead obtain the level of E's
+            --  named access type.
+
+            elsif Is_Named_Access_Type (Etype (E)) then
+               return Make_Level_Literal
+                        (Typ_Access_Level (Etype (E)));
+
+            --  A nondiscriminant selected component where the component
+            --  is an anonymous access type means that its associated
+            --  level is that of the containing type - see RM 3.10.2 (16).
+
+            --  Note that when restriction No_Dynamic_Accessibility_Checks is
+            --  in effect we treat discriminant components as regular
+            --  components.
+
+            elsif
+              (Nkind (E) = N_Selected_Component
+                and then Ekind (Etype (E))   =  E_Anonymous_Access_Type
+                and then Ekind (Etype (Pre)) /= E_Anonymous_Access_Type
+                and then (not (Nkind (Selector_Name (E)) in N_Has_Entity
+                                and then Ekind (Entity (Selector_Name (E)))
+                                           = E_Discriminant)
+
+                           --  The alternative accessibility models both treat
+                           --  discriminants as regular components.
+
+                           or else (No_Dynamic_Accessibility_Checks_Enabled (E)
+                                     and then Allow_Alt_Model)))
+
+              --  Arrays featuring components of anonymous access components
+              --  get their corresponding level from their containing type's
+              --  declaration.
+
+              or else
+                (Nkind (E) = N_Indexed_Component
+                  and then Ekind (Etype (E)) = E_Anonymous_Access_Type
+                  and then Ekind (Etype (Pre)) in Array_Kind
+                  and then Ekind (Component_Type (Base_Type (Etype (Pre))))
+                             = E_Anonymous_Access_Type)
+            then
+               --  When restriction No_Dynamic_Accessibility_Checks is active
+               --  and -gnatd_b set, the level is that of the designated type.
+
+               if Allow_Alt_Model
+                 and then No_Dynamic_Accessibility_Checks_Enabled (E)
+                 and then Debug_Flag_Underscore_B
+               then
+                  return Make_Level_Literal
+                           (Typ_Access_Level (Etype (E)));
+               end if;
+
+               --  Otherwise proceed normally
+
+               return Make_Level_Literal
+                        (Typ_Access_Level (Etype (Prefix (E))));
+
+            --  The accessibility calculation routine that handles function
+            --  calls (Function_Call_Level) assumes, in the case the
+            --  result is of an anonymous access type, that the result will be
+            --  used "in its entirety" when the call is present within an
+            --  assignment or object declaration.
+
+            --  To properly handle cases where the result is not used in its
+            --  entirety, we test if the prefix of the component in question is
+            --  a function call, which tells us that one of its components has
+            --  been identified and is being accessed. Therefore we can
+            --  conclude that the result is not used "in its entirety"
+            --  according to RM 3.10.2 (10.2/3).
+
+            elsif Nkind (Pre) = N_Function_Call
+              and then not Is_Named_Access_Type (Etype (Pre))
+            then
+               --  Dynamic checks are generated when we are within a return
+               --  value or we are in a function call within an anonymous
+               --  access discriminant constraint of a return object (signified
+               --  by In_Return_Context) on the side of the callee.
+
+               --  So, in this case, return a library accessibility level to
+               --  null out the check on the side of the caller.
+
+               if (In_Return_Value (E)
+                    or else In_Return_Context)
+                 and then Level /= Dynamic_Level
+               then
+                  return Make_Level_Literal
+                           (Scope_Depth (Standard_Standard));
+               end if;
+
+               return Make_Level_Literal
+                        (Innermost_Master_Scope_Depth (Expr));
+
+            --  Otherwise, continue recursing over the expression prefixes
+
+            else
+               return Accessibility_Level (Prefix (E));
+            end if;
+
+         --  Qualified expressions
+
+         when N_Qualified_Expression =>
+            if Is_Named_Access_Type (Etype (E)) then
+               return Make_Level_Literal
+                        (Typ_Access_Level (Etype (E)));
+            else
+               return Accessibility_Level (Expression (E));
+            end if;
+
+         --  Handle function calls
+
+         when N_Function_Call =>
+            return Function_Call_Or_Allocator_Level (E);
+
+         --  Explicit dereference accessibility level calculation
+
+         when N_Explicit_Dereference =>
+            Pre := Original_Node (Prefix (E));
+
+            --  The prefix is a named access type so the level is taken from
+            --  its type.
+
+            if Is_Named_Access_Type (Etype (Pre)) then
+               return Make_Level_Literal (Typ_Access_Level (Etype (Pre)));
+
+            --  Otherwise, recurse deeper
+
+            else
+               return Accessibility_Level (Prefix (E));
+            end if;
+
+         --  Type conversions
+
+         when N_Type_Conversion | N_Unchecked_Type_Conversion =>
+            --  View conversions are special in that they require use to
+            --  inspect the expression of the type conversion.
+
+            --  Allocators of anonymous access types are internally generated,
+            --  so recurse deeper in that case as well.
+
+            if Is_View_Conversion (E)
+              or else Ekind (Etype (E)) = E_Anonymous_Access_Type
+            then
+               return Accessibility_Level (Expression (E));
+
+            --  We don't care about the master if we are looking at a named
+            --  access type.
+
+            elsif Is_Named_Access_Type (Etype (E)) then
+               return Make_Level_Literal
+                        (Typ_Access_Level (Etype (E)));
+
+            --  In section RM 3.10.2 (10/4) the accessibility rules for
+            --  aggregates and value conversions are outlined. Are these
+            --  followed in the case of initialization of an object ???
+
+            --  Should use Innermost_Master_Scope_Depth ???
+
+            else
+               return Accessibility_Level (Current_Scope);
+            end if;
+
+         --  Default to the type accessibility level for the type of the
+         --  expression's entity.
+
+         when others =>
+            return Make_Level_Literal (Typ_Access_Level (Etype (E)));
+      end case;
+   end Accessibility_Level;
+
+   -------------------------------
+   -- Apply_Accessibility_Check --
+   -------------------------------
+
+   procedure Apply_Accessibility_Check
+     (N           : Node_Id;
+      Typ         : Entity_Id;
+      Insert_Node : Node_Id)
+   is
+      Loc : constant Source_Ptr := Sloc (N);
+
+      Check_Cond  : Node_Id;
+      Param_Ent   : Entity_Id := Param_Entity (N);
+      Param_Level : Node_Id;
+      Type_Level  : Node_Id;
+
+   begin
+      --  Verify we haven't tried to add a dynamic accessibility check when we
+      --  shouldn't.
+
+      pragma Assert (not No_Dynamic_Accessibility_Checks_Enabled (N));
+
+      if Ada_Version >= Ada_2012
+         and then No (Param_Ent)
+         and then Is_Entity_Name (N)
+         and then Ekind (Entity (N)) in E_Constant | E_Variable
+         and then Present (Effective_Extra_Accessibility (Entity (N)))
+      then
+         Param_Ent := Entity (N);
+         while Present (Renamed_Object (Param_Ent)) loop
+            --  Renamed_Object must return an Entity_Name here
+            --  because of preceding "Present (E_E_A (...))" test.
+
+            Param_Ent := Entity (Renamed_Object (Param_Ent));
+         end loop;
+      end if;
+
+      if Inside_A_Generic then
+         return;
+
+      --  Only apply the run-time check if the access parameter has an
+      --  associated extra access level parameter and when accessibility checks
+      --  are enabled.
+
+      elsif Present (Param_Ent)
+         and then Present (Get_Dynamic_Accessibility (Param_Ent))
+         and then not Accessibility_Checks_Suppressed (Param_Ent)
+         and then not Accessibility_Checks_Suppressed (Typ)
+      then
+         --  Obtain the parameter's accessibility level
+
+         Param_Level :=
+           New_Occurrence_Of (Get_Dynamic_Accessibility (Param_Ent), Loc);
+
+         --  Use the dynamic accessibility parameter for the function's result
+         --  when one has been created instead of statically referring to the
+         --  deepest type level so as to appropriatly handle the rules for
+         --  RM 3.10.2 (10.1/3).
+
+         if Ekind (Scope (Param_Ent)) = E_Function
+           and then In_Return_Value (N)
+           and then Ekind (Typ) = E_Anonymous_Access_Type
+         then
+            --  Associate the level of the result type to the extra result
+            --  accessibility parameter belonging to the current function.
+
+            if Present (Extra_Accessibility_Of_Result (Scope (Param_Ent))) then
+               Type_Level :=
+                 New_Occurrence_Of
+                   (Extra_Accessibility_Of_Result (Scope (Param_Ent)), Loc);
+
+            --  In Ada 2005 and earlier modes, a result extra accessibility
+            --  parameter is not generated and no dynamic check is performed.
+
+            else
+               return;
+            end if;
+
+         --  Otherwise get the type's accessibility level normally
+
+         else
+            Type_Level :=
+              Make_Integer_Literal (Loc, Deepest_Type_Access_Level (Typ));
+         end if;
+
+         --  Raise Program_Error if the accessibility level of the access
+         --  parameter is deeper than the level of the target access type.
+
+         Check_Cond :=
+           Make_Op_Gt (Loc,
+             Left_Opnd  => Param_Level,
+             Right_Opnd => Type_Level);
+
+         Insert_Action (Insert_Node,
+           Make_Raise_Program_Error (Loc,
+             Condition => Check_Cond,
+             Reason    => PE_Accessibility_Check_Failed));
+
+         Analyze_And_Resolve (N);
+
+         --  If constant folding has happened on the condition for the
+         --  generated error, then warn about it being unconditional.
+
+         if Nkind (Check_Cond) = N_Identifier
+           and then Entity (Check_Cond) = Standard_True
+         then
+            Error_Msg_Warn := SPARK_Mode /= On;
+            Error_Msg_N ("accessibility check fails<<", N);
+            Error_Msg_N ("\Program_Error [<<", N);
+         end if;
+      end if;
+   end Apply_Accessibility_Check;
+
+   ---------------------------------------------
+   -- Apply_Accessibility_Check_For_Allocator --
+   ---------------------------------------------
+
+   procedure Apply_Accessibility_Check_For_Allocator
+     (N              : Node_Id;
+      Exp            : Node_Id;
+      Ref            : Node_Id;
+      Built_In_Place : Boolean := False)
+   is
+      Loc       : constant Source_Ptr := Sloc (N);
+      PtrT      : constant Entity_Id  := Etype (N);
+      DesigT    : constant Entity_Id  := Designated_Type (PtrT);
+      Pool_Id   : constant Entity_Id  := Associated_Storage_Pool (PtrT);
+      Cond      : Node_Id;
+      Fin_Call  : Node_Id;
+      Free_Stmt : Node_Id;
+      Obj_Ref   : Node_Id;
+      Stmts     : List_Id;
+
+   begin
+      if Ada_Version >= Ada_2005
+        and then Is_Class_Wide_Type (DesigT)
+        and then Tagged_Type_Expansion
+        and then not Scope_Suppress.Suppress (Accessibility_Check)
+        and then not No_Dynamic_Accessibility_Checks_Enabled (Ref)
+        and then
+          (Type_Access_Level (Etype (Exp)) > Type_Access_Level (PtrT)
+            or else
+              (Is_Class_Wide_Type (Etype (Exp))
+                and then Scope (PtrT) /= Current_Scope))
+      then
+         --  If the allocator was built in place, Ref is already a reference
+         --  to the access object initialized to the result of the allocator
+         --  (see Exp_Ch6.Make_Build_In_Place_Call_In_Allocator). We call
+         --  Remove_Side_Effects for cases where the build-in-place call may
+         --  still be the prefix of the reference (to avoid generating
+         --  duplicate calls). Otherwise, it is the entity associated with
+         --  the object containing the address of the allocated object.
+
+         if Built_In_Place then
+            Remove_Side_Effects (Ref);
+            Obj_Ref := New_Copy_Tree (Ref);
+         else
+            Obj_Ref := New_Occurrence_Of (Ref, Loc);
+         end if;
+
+         --  For access to interface types we must generate code to displace
+         --  the pointer to the base of the object since the subsequent code
+         --  references components located in the TSD of the object (which
+         --  is associated with the primary dispatch table --see a-tags.ads)
+         --  and also generates code invoking Free, which requires also a
+         --  reference to the base of the unallocated object.
+
+         if Is_Interface (DesigT) and then Tagged_Type_Expansion then
+            Obj_Ref :=
+              Unchecked_Convert_To (Etype (Obj_Ref),
+                Make_Function_Call (Loc,
+                  Name                   =>
+                    New_Occurrence_Of (RTE (RE_Base_Address), Loc),
+                  Parameter_Associations => New_List (
+                    Unchecked_Convert_To (RTE (RE_Address),
+                      New_Copy_Tree (Obj_Ref)))));
+         end if;
+
+         --  Step 1: Create the object clean up code
+
+         Stmts := New_List;
+
+         --  Deallocate the object if the accessibility check fails. This is
+         --  done only on targets or profiles that support deallocation.
+
+         --    Free (Obj_Ref);
+
+         if RTE_Available (RE_Free) then
+            Free_Stmt := Make_Free_Statement (Loc, New_Copy_Tree (Obj_Ref));
+            Set_Storage_Pool (Free_Stmt, Pool_Id);
+
+            Append_To (Stmts, Free_Stmt);
+
+         --  The target or profile cannot deallocate objects
+
+         else
+            Free_Stmt := Empty;
+         end if;
+
+         --  Finalize the object if applicable. Generate:
+
+         --    [Deep_]Finalize (Obj_Ref.all);
+
+         if Needs_Finalization (DesigT)
+           and then not No_Heap_Finalization (PtrT)
+         then
+            Fin_Call :=
+              Make_Final_Call
+                (Obj_Ref =>
+                   Make_Explicit_Dereference (Loc, New_Copy (Obj_Ref)),
+                 Typ     => DesigT);
+
+            --  Guard against a missing [Deep_]Finalize when the designated
+            --  type was not properly frozen.
+
+            if No (Fin_Call) then
+               Fin_Call := Make_Null_Statement (Loc);
+            end if;
+
+            --  When the target or profile supports deallocation, wrap the
+            --  finalization call in a block to ensure proper deallocation even
+            --  if finalization fails. Generate:
+
+            --    begin
+            --       <Fin_Call>
+            --    exception
+            --       when others =>
+            --          <Free_Stmt>
+            --          raise;
+            --    end;
+
+            if Present (Free_Stmt) then
+               Fin_Call :=
+                 Make_Block_Statement (Loc,
+                   Handled_Statement_Sequence =>
+                     Make_Handled_Sequence_Of_Statements (Loc,
+                       Statements => New_List (Fin_Call),
+
+                     Exception_Handlers => New_List (
+                       Make_Exception_Handler (Loc,
+                         Exception_Choices => New_List (
+                           Make_Others_Choice (Loc)),
+                         Statements        => New_List (
+                           New_Copy_Tree (Free_Stmt),
+                           Make_Raise_Statement (Loc))))));
+            end if;
+
+            Prepend_To (Stmts, Fin_Call);
+         end if;
+
+         --  Signal the accessibility failure through a Program_Error
+
+         Append_To (Stmts,
+           Make_Raise_Program_Error (Loc,
+             Reason => PE_Accessibility_Check_Failed));
+
+         --  Step 2: Create the accessibility comparison
+
+         --  Generate:
+         --    Ref'Tag
+
+         Obj_Ref :=
+           Make_Attribute_Reference (Loc,
+             Prefix         => Obj_Ref,
+             Attribute_Name => Name_Tag);
+
+         --  For tagged types, determine the accessibility level by looking at
+         --  the type specific data of the dispatch table. Generate:
+
+         --    Type_Specific_Data (Address (Ref'Tag)).Access_Level
+
+         if Tagged_Type_Expansion then
+            Cond := Build_Get_Access_Level (Loc, Obj_Ref);
+
+         --  Use a runtime call to determine the accessibility level when
+         --  compiling on virtual machine targets. Generate:
+
+         --    Get_Access_Level (Ref'Tag)
+
+         else
+            Cond :=
+              Make_Function_Call (Loc,
+                Name                   =>
+                  New_Occurrence_Of (RTE (RE_Get_Access_Level), Loc),
+                Parameter_Associations => New_List (Obj_Ref));
+         end if;
+
+         Cond :=
+           Make_Op_Gt (Loc,
+             Left_Opnd  => Cond,
+             Right_Opnd => Accessibility_Level (N, Dynamic_Level));
+
+         --  Due to the complexity and side effects of the check, utilize an if
+         --  statement instead of the regular Program_Error circuitry.
+
+         Insert_Action (N,
+           Make_Implicit_If_Statement (N,
+             Condition       => Cond,
+             Then_Statements => Stmts));
+      end if;
+   end Apply_Accessibility_Check_For_Allocator;
+
+   ------------------------------------------
+   -- Check_Return_Construct_Accessibility --
+   ------------------------------------------
+
+   procedure Check_Return_Construct_Accessibility
+     (Return_Stmt : Node_Id;
+      Stm_Entity  : Entity_Id)
+   is
+      Loc      : constant Source_Ptr := Sloc (Return_Stmt);
+      Scope_Id : constant Entity_Id  := Return_Applies_To (Stm_Entity);
+
+      R_Type : constant Entity_Id := Etype (Scope_Id);
+      --  Function result subtype
+
+      function First_Selector (Assoc : Node_Id) return Node_Id;
+      --  Obtain the first selector or choice from a given association
+
+      function Is_Formal_Of_Current_Function
+        (Assoc_Expr : Entity_Id) return Boolean;
+      --  Predicate to test if a given expression associated with a
+      --  discriminant is a formal parameter to the function in which the
+      --  return construct we checking applies to.
+
+      --------------------
+      -- First_Selector --
+      --------------------
+
+      function First_Selector (Assoc : Node_Id) return Node_Id is
+      begin
+         if Nkind (Assoc) = N_Component_Association then
+            return First (Choices (Assoc));
+
+         elsif Nkind (Assoc) = N_Discriminant_Association then
+            return (First (Selector_Names (Assoc)));
+
+         else
+            raise Program_Error;
+         end if;
+      end First_Selector;
+
+      -----------------------------------
+      -- Is_Formal_Of_Current_Function --
+      -----------------------------------
+
+      function Is_Formal_Of_Current_Function
+        (Assoc_Expr : Entity_Id) return Boolean is
+      begin
+         return Is_Entity_Name (Assoc_Expr)
+                  and then Enclosing_Subprogram
+                             (Entity (Assoc_Expr)) = Scope_Id
+                  and then Is_Formal (Entity (Assoc_Expr));
+      end Is_Formal_Of_Current_Function;
+
+      --  Local declarations
+
+      Assoc : Node_Id := Empty;
+      --  Assoc should perhaps be renamed and declared as a
+      --  Node_Or_Entity_Id since it encompasses not only component and
+      --  discriminant associations, but also discriminant components within
+      --  a type declaration or subtype indication ???
+
+      Assoc_Expr    : Node_Id;
+      Assoc_Present : Boolean := False;
+
+      Check_Cond        : Node_Id;
+      Unseen_Disc_Count : Nat := 0;
+      Seen_Discs        : Elist_Id;
+      Disc              : Entity_Id;
+      First_Disc        : Entity_Id;
+
+      Obj_Decl   : Node_Id;
+      Return_Con : Node_Id;
+      Unqual     : Node_Id;
+
+   --  Start of processing for Check_Return_Construct_Accessibility
+
+   begin
+      --  Only perform checks on record types with access discriminants and
+      --  non-internally generated functions.
+
+      if not Is_Record_Type (R_Type)
+        or else not Has_Anonymous_Access_Discriminant (R_Type)
+        or else not Comes_From_Source (Return_Stmt)
+      then
+         return;
+      end if;
+
+      --  We are only interested in return statements
+
+      if Nkind (Return_Stmt) not in
+           N_Extended_Return_Statement | N_Simple_Return_Statement
+      then
+         return;
+      end if;
+
+      --  Fetch the object from the return statement, in the case of a
+      --  simple return statement the expression is part of the node.
+
+      if Nkind (Return_Stmt) = N_Extended_Return_Statement then
+         --  Obtain the object definition from the expanded extended return
+
+         Return_Con := First (Return_Object_Declarations (Return_Stmt));
+         while Present (Return_Con) loop
+            --  Inspect the original node to avoid object declarations
+            --  expanded into renamings.
+
+            if Nkind (Original_Node (Return_Con)) = N_Object_Declaration
+              and then Comes_From_Source (Original_Node (Return_Con))
+            then
+               exit;
+            end if;
+
+            Nlists.Next (Return_Con);
+         end loop;
+
+         pragma Assert (Present (Return_Con));
+
+         --  Could be dealing with a renaming
+
+         Return_Con := Original_Node (Return_Con);
+      else
+         Return_Con := Expression (Return_Stmt);
+      end if;
+
+      --  Obtain the accessibility levels of the expressions associated
+      --  with all anonymous access discriminants, then generate a
+      --  dynamic check or static error when relevant.
+
+      --  Note the repeated use of Original_Node to avoid checking
+      --  expanded code.
+
+      Unqual := Original_Node (Unqualify (Original_Node (Return_Con)));
+
+      --  Get the corresponding declaration based on the return object's
+      --  identifier.
+
+      if Nkind (Unqual) = N_Identifier
+        and then Nkind (Parent (Entity (Unqual)))
+                   in N_Object_Declaration
+                    | N_Object_Renaming_Declaration
+      then
+         Obj_Decl := Original_Node (Parent (Entity (Unqual)));
+
+      --  We were passed the object declaration directly, so use it
+
+      elsif Nkind (Unqual) in N_Object_Declaration
+                            | N_Object_Renaming_Declaration
+      then
+         Obj_Decl := Unqual;
+
+      --  Otherwise, we are looking at something else
+
+      else
+         Obj_Decl := Empty;
+
+      end if;
+
+      --  Hop up object renamings when present
+
+      if Present (Obj_Decl)
+        and then Nkind (Obj_Decl) = N_Object_Renaming_Declaration
+      then
+         while Nkind (Obj_Decl) = N_Object_Renaming_Declaration loop
+
+            if Nkind (Name (Obj_Decl)) not in N_Entity then
+               --  We may be looking at the expansion of iterators or
+               --  some other internally generated construct, so it is safe
+               --  to ignore checks ???
+
+               if not Comes_From_Source (Obj_Decl) then
+                  return;
+               end if;
+
+               Obj_Decl := Original_Node
+                             (Declaration_Node
+                               (Ultimate_Prefix (Name (Obj_Decl))));
+
+            --  Move up to the next declaration based on the object's name
+
+            else
+               Obj_Decl := Original_Node
+                             (Declaration_Node (Name (Obj_Decl)));
+            end if;
+         end loop;
+      end if;
+
+      --  Obtain the discriminant values from the return aggregate
+
+      --  Do we cover extension aggregates correctly ???
+
+      if Nkind (Unqual) = N_Aggregate then
+         if Present (Expressions (Unqual)) then
+            Assoc := First (Expressions (Unqual));
+         else
+            Assoc := First (Component_Associations (Unqual));
+         end if;
+
+      --  There is an object declaration for the return object
+
+      elsif Present (Obj_Decl) then
+         --  When a subtype indication is present in an object declaration
+         --  it must contain the object's discriminants.
+
+         if Nkind (Object_Definition (Obj_Decl)) = N_Subtype_Indication then
+            Assoc := First
+                       (Constraints
+                         (Constraint
+                           (Object_Definition (Obj_Decl))));
+
+         --  The object declaration contains an aggregate
+
+         elsif Present (Expression (Obj_Decl)) then
+
+            if Nkind (Unqualify (Expression (Obj_Decl))) = N_Aggregate then
+               --  Grab the first associated discriminant expresion
+
+               if Present
+                    (Expressions (Unqualify (Expression (Obj_Decl))))
+               then
+                  Assoc := First
+                             (Expressions
+                               (Unqualify (Expression (Obj_Decl))));
+               else
+                  Assoc := First
+                             (Component_Associations
+                               (Unqualify (Expression (Obj_Decl))));
+               end if;
+
+            --  Otherwise, this is something else
+
+            else
+               return;
+            end if;
+
+         --  There are no supplied discriminants in the object declaration,
+         --  so get them from the type definition since they must be default
+         --  initialized.
+
+         --  Do we handle constrained subtypes correctly ???
+
+         elsif Nkind (Unqual) = N_Object_Declaration then
+            Assoc := First_Discriminant
+                       (Etype (Object_Definition (Obj_Decl)));
+
+         else
+            Assoc := First_Discriminant (Etype (Unqual));
+         end if;
+
+      --  When we are not looking at an aggregate or an identifier, return
+      --  since any other construct (like a function call) is not
+      --  applicable since checks will be performed on the side of the
+      --  callee.
+
+      else
+         return;
+      end if;
+
+      --  Obtain the discriminants so we know the actual type in case the
+      --  value of their associated expression gets implicitly converted.
+
+      if No (Obj_Decl) then
+         pragma Assert (Nkind (Unqual) = N_Aggregate);
+
+         Disc := First_Discriminant (Etype (Unqual));
+
+      else
+         Disc := First_Discriminant
+                   (Etype (Defining_Identifier (Obj_Decl)));
+      end if;
+
+      --  Preserve the first discriminant for checking named associations
+
+      First_Disc := Disc;
+
+      --  Count the number of discriminants for processing an aggregate
+      --  which includes an others.
+
+      Disc := First_Disc;
+      while Present (Disc) loop
+         Unseen_Disc_Count := Unseen_Disc_Count + 1;
+
+         Next_Discriminant (Disc);
+      end loop;
+
+      Seen_Discs := New_Elmt_List;
+
+      --  Loop through each of the discriminants and check each expression
+      --  associated with an anonymous access discriminant.
+
+      --  When named associations occur in the return aggregate then
+      --  discriminants can be in any order, so we need to ensure we do
+      --  not continue to loop when all discriminants have been seen.
+
+      Disc := First_Disc;
+      while Present (Assoc)
+        and then (Present (Disc) or else Assoc_Present)
+        and then Unseen_Disc_Count > 0
+      loop
+         --  Handle named associations by searching through the names of
+         --  the relevant discriminant components.
+
+         if Nkind (Assoc)
+              in N_Component_Association | N_Discriminant_Association
+         then
+            Assoc_Expr    := Expression (Assoc);
+            Assoc_Present := True;
+
+            --  We currently don't handle box initialized discriminants,
+            --  however, since default initialized anonymous access
+            --  discriminants are a corner case, this is ok for now ???
+
+            if Nkind (Assoc) = N_Component_Association
+              and then Box_Present (Assoc)
+            then
+               if Nkind (First_Selector (Assoc)) = N_Others_Choice then
+                  Unseen_Disc_Count := 0;
+               end if;
+
+            --  When others is present we must identify a discriminant we
+            --  haven't already seen so as to get the appropriate type for
+            --  the static accessibility check.
+
+            --  This works because all components within an others clause
+            --  must have the same type.
+
+            elsif Nkind (First_Selector (Assoc)) = N_Others_Choice then
+
+               Disc := First_Disc;
+               Outer : while Present (Disc) loop
+                  declare
+                     Current_Seen_Disc : Elmt_Id;
+                  begin
+                     --  Move through the list of identified discriminants
+
+                     Current_Seen_Disc := First_Elmt (Seen_Discs);
+                     while Present (Current_Seen_Disc) loop
+                        --  Exit the loop when we found a match
+
+                        exit when
+                          Chars (Node (Current_Seen_Disc)) = Chars (Disc);
+
+                        Next_Elmt (Current_Seen_Disc);
+                     end loop;
+
+                     --  When we have exited the above loop without finding
+                     --  a match then we know that Disc has not been seen.
+
+                     exit Outer when No (Current_Seen_Disc);
+                  end;
+
+                  Next_Discriminant (Disc);
+               end loop Outer;
+
+               --  If we got to an others clause with a non-zero
+               --  discriminant count there must be a discriminant left to
+               --  check.
+
+               pragma Assert (Present (Disc));
+
+               --  Set the unseen discriminant count to zero because we know
+               --  an others clause sets all remaining components of an
+               --  aggregate.
+
+               Unseen_Disc_Count := 0;
+
+            --  Move through each of the selectors in the named association
+            --  and obtain a discriminant for accessibility checking if one
+            --  is referenced in the list. Also track which discriminants
+            --  are referenced for the purpose of handling an others clause.
+
+            else
+               declare
+                  Assoc_Choice : Node_Id;
+                  Curr_Disc    : Node_Id;
+               begin
+
+                  Disc      := Empty;
+                  Curr_Disc := First_Disc;
+                  while Present (Curr_Disc) loop
+                     --  Check each of the choices in the associations for a
+                     --  match to the name of the current discriminant.
+
+                     Assoc_Choice := First_Selector (Assoc);
+                     while Present (Assoc_Choice) loop
+                        --  When the name matches we track that we have seen
+                        --  the discriminant, but instead of exiting the
+                        --  loop we continue iterating to make sure all the
+                        --  discriminants within the named association get
+                        --  tracked.
+
+                        if Chars (Assoc_Choice) = Chars (Curr_Disc) then
+                           Append_Elmt (Curr_Disc, Seen_Discs);
+
+                           Disc              := Curr_Disc;
+                           Unseen_Disc_Count := Unseen_Disc_Count - 1;
+                        end if;
+
+                        Next (Assoc_Choice);
+                     end loop;
+
+                     Next_Discriminant (Curr_Disc);
+                  end loop;
+               end;
+            end if;
+
+         --  Unwrap the associated expression if we are looking at a default
+         --  initialized type declaration. In this case Assoc is not really
+         --  an association, but a component declaration. Should Assoc be
+         --  renamed in some way to be more clear ???
+
+         --  This occurs when the return object does not initialize
+         --  discriminant and instead relies on the type declaration for
+         --  their supplied values.
+
+         elsif Nkind (Assoc) in N_Entity
+           and then Ekind (Assoc) = E_Discriminant
+         then
+            Append_Elmt (Disc, Seen_Discs);
+
+            Assoc_Expr        := Discriminant_Default_Value (Assoc);
+            Unseen_Disc_Count := Unseen_Disc_Count - 1;
+
+         --  Otherwise, there is nothing to do because Assoc is an
+         --  expression within the return aggregate itself.
+
+         else
+            Append_Elmt (Disc, Seen_Discs);
+
+            Assoc_Expr        := Assoc;
+            Unseen_Disc_Count := Unseen_Disc_Count - 1;
+         end if;
+
+         --  Check the accessibility level of the expression when the
+         --  discriminant is of an anonymous access type.
+
+         if Present (Assoc_Expr)
+           and then Present (Disc)
+           and then Ekind (Etype (Disc)) = E_Anonymous_Access_Type
+
+           --  We disable the check when we have a tagged return type and
+           --  the associated expression for the discriminant is a formal
+           --  parameter since the check would require us to compare the
+           --  accessibility level of Assoc_Expr to the level of the
+           --  Extra_Accessibility_Of_Result of the function - which is
+           --  currently disabled for functions with tagged return types.
+           --  This may change in the future ???
+
+           --  See Needs_Result_Accessibility_Level for details.
+
+           and then not
+             (No (Extra_Accessibility_Of_Result (Scope_Id))
+               and then Is_Formal_Of_Current_Function (Assoc_Expr)
+               and then Is_Tagged_Type (Etype (Scope_Id)))
+         then
+            --  Generate a dynamic check based on the extra accessibility of
+            --  the result or the scope of the current function.
+
+            Check_Cond :=
+              Make_Op_Gt (Loc,
+                Left_Opnd  => Accessibility_Level
+                                (Expr              => Assoc_Expr,
+                                 Level             => Dynamic_Level,
+                                 In_Return_Context => True),
+                Right_Opnd =>
+                  (if Present (Extra_Accessibility_Of_Result (Scope_Id))
+
+                     --  When Assoc_Expr is a formal we have to look at the
+                     --  extra accessibility-level formal associated with
+                     --  the result.
+
+                     and then Is_Formal_Of_Current_Function (Assoc_Expr)
+                   then
+                      New_Occurrence_Of
+                        (Extra_Accessibility_Of_Result (Scope_Id), Loc)
+
+                   --  Otherwise, we compare the level of Assoc_Expr to the
+                   --  scope of the current function.
+
+                   else
+                      Make_Integer_Literal
+                        (Loc, Scope_Depth (Scope (Scope_Id)))));
+
+            Insert_Before_And_Analyze (Return_Stmt,
+              Make_Raise_Program_Error (Loc,
+                Condition => Check_Cond,
+                Reason    => PE_Accessibility_Check_Failed));
+
+            --  If constant folding has happened on the condition for the
+            --  generated error, then warn about it being unconditional when
+            --  we know an error will be raised.
+
+            if Nkind (Check_Cond) = N_Identifier
+              and then Entity (Check_Cond) = Standard_True
+            then
+               Error_Msg_N
+                 ("access discriminant in return object would be a dangling"
+                  & " reference", Return_Stmt);
+            end if;
+         end if;
+
+         --  Iterate over the discriminants, except when we have encountered
+         --  a named association since the discriminant order becomes
+         --  irrelevant in that case.
+
+         if not Assoc_Present then
+            Next_Discriminant (Disc);
+         end if;
+
+         --  Iterate over associations
+
+         if not Is_List_Member (Assoc) then
+            exit;
+         else
+            Nlists.Next (Assoc);
+         end if;
+      end loop;
+   end Check_Return_Construct_Accessibility;
+
+   -------------------------------
+   -- Deepest_Type_Access_Level --
+   -------------------------------
+
+   function Deepest_Type_Access_Level
+     (Typ             : Entity_Id;
+      Allow_Alt_Model : Boolean := True) return Uint
+   is
+   begin
+      if Ekind (Typ) = E_Anonymous_Access_Type
+        and then not Is_Local_Anonymous_Access (Typ)
+        and then Nkind (Associated_Node_For_Itype (Typ)) = N_Object_Declaration
+      then
+         --  No_Dynamic_Accessibility_Checks override for alternative
+         --  accessibility model.
+
+         if Allow_Alt_Model
+           and then No_Dynamic_Accessibility_Checks_Enabled (Typ)
+         then
+            return Type_Access_Level (Typ, Allow_Alt_Model);
+         end if;
+
+         --  Typ is the type of an Ada 2012 stand-alone object of an anonymous
+         --  access type.
+
+         return
+           Scope_Depth (Enclosing_Dynamic_Scope
+                         (Defining_Identifier
+                           (Associated_Node_For_Itype (Typ))));
+
+      --  For generic formal type, return Int'Last (infinite).
+      --  See comment preceding Is_Generic_Type call in Type_Access_Level.
+
+      elsif Is_Generic_Type (Root_Type (Typ)) then
+         return UI_From_Int (Int'Last);
+
+      else
+         return Type_Access_Level (Typ, Allow_Alt_Model);
+      end if;
+   end Deepest_Type_Access_Level;
+
+   -----------------------------------
+   -- Effective_Extra_Accessibility --
+   -----------------------------------
+
+   function Effective_Extra_Accessibility (Id : Entity_Id) return Entity_Id is
+   begin
+      if Present (Renamed_Object (Id))
+        and then Is_Entity_Name (Renamed_Object (Id))
+      then
+         return Effective_Extra_Accessibility (Entity (Renamed_Object (Id)));
+      else
+         return Extra_Accessibility (Id);
+      end if;
+   end Effective_Extra_Accessibility;
+
+   -------------------------------
+   -- Get_Dynamic_Accessibility --
+   -------------------------------
+
+   function Get_Dynamic_Accessibility (E : Entity_Id) return Entity_Id is
+   begin
+      --  When minimum accessibility is set for E then we utilize it - except
+      --  in a few edge cases like the expansion of select statements where
+      --  generated subprogram may attempt to unnecessarily use a minimum
+      --  accessibility object declared outside of scope.
+
+      --  To avoid these situations where expansion may get complex we verify
+      --  that the minimum accessibility object is within scope.
+
+      if Is_Formal (E)
+        and then Present (Minimum_Accessibility (E))
+        and then In_Open_Scopes (Scope (Minimum_Accessibility (E)))
+      then
+         return Minimum_Accessibility (E);
+      end if;
+
+      return Extra_Accessibility (E);
+   end Get_Dynamic_Accessibility;
+
+   -----------------------
+   -- Has_Access_Values --
+   -----------------------
+
+   function Has_Access_Values (T : Entity_Id) return Boolean
+   is
+      Typ : constant Entity_Id := Underlying_Type (T);
+
+   begin
+      --  Case of a private type which is not completed yet. This can only
+      --  happen in the case of a generic formal type appearing directly, or
+      --  as a component of the type to which this function is being applied
+      --  at the top level. Return False in this case, since we certainly do
+      --  not know that the type contains access types.
+
+      if No (Typ) then
+         return False;
+
+      elsif Is_Access_Type (Typ) then
+         return True;
+
+      elsif Is_Array_Type (Typ) then
+         return Has_Access_Values (Component_Type (Typ));
+
+      elsif Is_Record_Type (Typ) then
+         declare
+            Comp : Entity_Id;
+
+         begin
+            --  Loop to check components
+
+            Comp := First_Component_Or_Discriminant (Typ);
+            while Present (Comp) loop
+
+               --  Check for access component, tag field does not count, even
+               --  though it is implemented internally using an access type.
+
+               if Has_Access_Values (Etype (Comp))
+                 and then Chars (Comp) /= Name_uTag
+               then
+                  return True;
+               end if;
+
+               Next_Component_Or_Discriminant (Comp);
+            end loop;
+         end;
+
+         return False;
+
+      else
+         return False;
+      end if;
+   end Has_Access_Values;
+
+   ---------------------------------------
+   -- Has_Anonymous_Access_Discriminant --
+   ---------------------------------------
+
+   function Has_Anonymous_Access_Discriminant (Typ : Entity_Id) return Boolean
+   is
+      Disc : Node_Id;
+
+   begin
+      if not Has_Discriminants (Typ) then
+         return False;
+      end if;
+
+      Disc := First_Discriminant (Typ);
+      while Present (Disc) loop
+         if Ekind (Etype (Disc)) = E_Anonymous_Access_Type then
+            return True;
+         end if;
+
+         Next_Discriminant (Disc);
+      end loop;
+
+      return False;
+   end Has_Anonymous_Access_Discriminant;
+
+   --------------------------------------------
+   -- Has_Unconstrained_Access_Discriminants --
+   --------------------------------------------
+
+   function Has_Unconstrained_Access_Discriminants
+     (Subtyp : Entity_Id) return Boolean
+   is
+      Discr : Entity_Id;
+
+   begin
+      if Has_Discriminants (Subtyp)
+        and then not Is_Constrained (Subtyp)
+      then
+         Discr := First_Discriminant (Subtyp);
+         while Present (Discr) loop
+            if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then
+               return True;
+            end if;
+
+            Next_Discriminant (Discr);
+         end loop;
+      end if;
+
+      return False;
+   end Has_Unconstrained_Access_Discriminants;
+
+   --------------------------------
+   -- Is_Anonymous_Access_Actual --
+   --------------------------------
+
+   function Is_Anonymous_Access_Actual (N : Node_Id) return Boolean is
+      Par : Node_Id;
+   begin
+      if Ekind (Etype (N)) /= E_Anonymous_Access_Type then
+         return False;
+      end if;
+
+      Par := Parent (N);
+      while Present (Par)
+        and then Nkind (Par) in N_Case_Expression
+                              | N_If_Expression
+                              | N_Parameter_Association
+      loop
+         Par := Parent (Par);
+      end loop;
+      return Nkind (Par) in N_Subprogram_Call;
+   end Is_Anonymous_Access_Actual;
+
+   --------------------------------------
+   -- Is_Special_Aliased_Formal_Access --
+   --------------------------------------
+
+   function Is_Special_Aliased_Formal_Access
+     (Exp               : Node_Id;
+      In_Return_Context : Boolean := False) return Boolean
+   is
+      Scop : constant Entity_Id := Current_Subprogram;
+   begin
+      --  Verify the expression is an access reference to 'Access within a
+      --  return statement as this is the only time an explicitly aliased
+      --  formal has different semantics.
+
+      if Nkind (Exp) /= N_Attribute_Reference
+        or else Get_Attribute_Id (Attribute_Name (Exp)) /= Attribute_Access
+        or else not (In_Return_Value (Exp)
+                      or else In_Return_Context)
+        or else not Needs_Result_Accessibility_Level (Scop)
+      then
+         return False;
+      end if;
+
+      --  Check if the prefix of the reference is indeed an explicitly aliased
+      --  formal parameter for the function Scop. Additionally, we must check
+      --  that Scop returns an anonymous access type, otherwise the special
+      --  rules dictating a need for a dynamic check are not in effect.
+
+      return Is_Entity_Name (Prefix (Exp))
+               and then Is_Explicitly_Aliased (Entity (Prefix (Exp)));
+   end Is_Special_Aliased_Formal_Access;
+
+   --------------------------------------
+   -- Needs_Result_Accessibility_Level --
+   --------------------------------------
+
+   function Needs_Result_Accessibility_Level
+     (Func_Id : Entity_Id) return Boolean
+   is
+      Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
+
+      function Has_Unconstrained_Access_Discriminant_Component
+        (Comp_Typ : Entity_Id) return Boolean;
+      --  Returns True if any component of the type has an unconstrained access
+      --  discriminant.
+
+      -----------------------------------------------------
+      -- Has_Unconstrained_Access_Discriminant_Component --
+      -----------------------------------------------------
+
+      function Has_Unconstrained_Access_Discriminant_Component
+        (Comp_Typ :  Entity_Id) return Boolean
+      is
+      begin
+         if not Is_Limited_Type (Comp_Typ) then
+            return False;
+
+         --  Only limited types can have access discriminants with
+         --  defaults.
+
+         elsif Has_Unconstrained_Access_Discriminants (Comp_Typ) then
+            return True;
+
+         elsif Is_Array_Type (Comp_Typ) then
+            return Has_Unconstrained_Access_Discriminant_Component
+                     (Underlying_Type (Component_Type (Comp_Typ)));
+
+         elsif Is_Record_Type (Comp_Typ) then
+            declare
+               Comp : Entity_Id;
+
+            begin
+               Comp := First_Component (Comp_Typ);
+               while Present (Comp) loop
+                  if Has_Unconstrained_Access_Discriminant_Component
+                       (Underlying_Type (Etype (Comp)))
+                  then
+                     return True;
+                  end if;
+
+                  Next_Component (Comp);
+               end loop;
+            end;
+         end if;
+
+         return False;
+      end Has_Unconstrained_Access_Discriminant_Component;
+
+      Disable_Tagged_Cases : constant Boolean := True;
+      --  Flag used to temporarily disable a "True" result for tagged types.
+      --  See comments further below for details.
+
+   --  Start of processing for Needs_Result_Accessibility_Level
+
+   begin
+      --  False if completion unavailable, which can happen when we are
+      --  analyzing an abstract subprogram or if the subprogram has
+      --  delayed freezing.
+
+      if No (Func_Typ) then
+         return False;
+
+      --  False if not a function, also handle enum-lit renames case
+
+      elsif Func_Typ = Standard_Void_Type
+        or else Is_Scalar_Type (Func_Typ)
+      then
+         return False;
+
+      --  Handle a corner case, a cross-dialect subp renaming. For example,
+      --  an Ada 2012 renaming of an Ada 2005 subprogram. This can occur when
+      --  an Ada 2005 (or earlier) unit references predefined run-time units.
+
+      elsif Present (Alias (Func_Id)) then
+
+         --  Unimplemented: a cross-dialect subp renaming which does not set
+         --  the Alias attribute (e.g., a rename of a dereference of an access
+         --  to subprogram value). ???
+
+         return Present (Extra_Accessibility_Of_Result (Alias (Func_Id)));
+
+      --  Remaining cases require Ada 2012 mode, unless they are dispatching
+      --  operations, since they may be overridden by Ada_2012 primitives.
+
+      elsif Ada_Version < Ada_2012
+        and then not Is_Dispatching_Operation (Func_Id)
+      then
+         return False;
+
+      --  Handle the situation where a result is an anonymous access type
+      --  RM 3.10.2 (10.3/3).
+
+      elsif Ekind (Func_Typ) = E_Anonymous_Access_Type then
+         return True;
+
+      --  In the case of, say, a null tagged record result type, the need for
+      --  this extra parameter might not be obvious so this function returns
+      --  True for all tagged types for compatibility reasons.
+
+      --  A function with, say, a tagged null controlling result type might
+      --  be overridden by a primitive of an extension having an access
+      --  discriminant and the overrider and overridden must have compatible
+      --  calling conventions (including implicitly declared parameters).
+
+      --  Similarly, values of one access-to-subprogram type might designate
+      --  both a primitive subprogram of a given type and a function which is,
+      --  for example, not a primitive subprogram of any type. Again, this
+      --  requires calling convention compatibility. It might be possible to
+      --  solve these issues by introducing wrappers, but that is not the
+      --  approach that was chosen.
+
+      --  Note: Despite the reasoning noted above, the extra accessibility
+      --  parameter for tagged types is disabled for performance reasons.
+
+      elsif Is_Tagged_Type (Func_Typ) then
+         return not Disable_Tagged_Cases;
+
+      elsif Has_Unconstrained_Access_Discriminants (Func_Typ) then
+         return True;
+
+      elsif Has_Unconstrained_Access_Discriminant_Component (Func_Typ) then
+         return True;
+
+      --  False for all other cases
+
+      else
+         return False;
+      end if;
+   end Needs_Result_Accessibility_Level;
+
+   ------------------------------------------
+   -- Prefix_With_Safe_Accessibility_Level --
+   ------------------------------------------
+
+   function Prefix_With_Safe_Accessibility_Level
+     (N   : Node_Id;
+      Typ : Entity_Id) return Boolean
+   is
+      P        : constant Node_Id      := Prefix (N);
+      Aname    : constant Name_Id      := Attribute_Name (N);
+      Attr_Id  : constant Attribute_Id := Get_Attribute_Id (Aname);
+      Btyp     : constant Entity_Id    := Base_Type (Typ);
+
+      function Safe_Value_Conversions return Boolean;
+      --  Return False if the prefix has a value conversion of an array type
+
+      ----------------------------
+      -- Safe_Value_Conversions --
+      ----------------------------
+
+      function Safe_Value_Conversions return Boolean is
+         PP : Node_Id := P;
+
+      begin
+         loop
+            if Nkind (PP) in N_Selected_Component | N_Indexed_Component then
+               PP := Prefix (PP);
+
+            elsif Comes_From_Source (PP)
+              and then Nkind (PP) in N_Type_Conversion
+                                   | N_Unchecked_Type_Conversion
+              and then Is_Array_Type (Etype (PP))
+            then
+               return False;
+
+            elsif Comes_From_Source (PP)
+              and then Nkind (PP) = N_Qualified_Expression
+              and then Is_Array_Type (Etype (PP))
+              and then Nkind (Original_Node (Expression (PP))) in
+                         N_Aggregate | N_Extension_Aggregate
+            then
+               return False;
+
+            else
+               exit;
+            end if;
+         end loop;
+
+         return True;
+      end Safe_Value_Conversions;
+
+   --  Start of processing for Prefix_With_Safe_Accessibility_Level
+
+   begin
+      --  No check required for unchecked and unrestricted access
+
+      if Attr_Id = Attribute_Unchecked_Access
+        or else Attr_Id = Attribute_Unrestricted_Access
+      then
+         return True;
+
+      --  Check value conversions
+
+      elsif Ekind (Btyp) = E_General_Access_Type
+        and then not Safe_Value_Conversions
+      then
+         return False;
+      end if;
+
+      return True;
+   end Prefix_With_Safe_Accessibility_Level;
+
+   -----------------------------
+   -- Subprogram_Access_Level --
+   -----------------------------
+
+   function Subprogram_Access_Level (Subp : Entity_Id) return Uint is
+   begin
+      if Present (Alias (Subp)) then
+         return Subprogram_Access_Level (Alias (Subp));
+      else
+         return Scope_Depth (Enclosing_Dynamic_Scope (Subp));
+      end if;
+   end Subprogram_Access_Level;
+
+   --------------------------------
+   -- Static_Accessibility_Level --
+   --------------------------------
+
+   function Static_Accessibility_Level
+     (Expr              : Node_Id;
+      Level             : Static_Accessibility_Level_Kind;
+      In_Return_Context : Boolean := False) return Uint
+   is
+   begin
+      return Intval
+               (Accessibility_Level (Expr, Level, In_Return_Context));
+   end Static_Accessibility_Level;
+
+   -----------------------
+   -- Type_Access_Level --
+   -----------------------
+
+   function Type_Access_Level
+     (Typ             : Entity_Id;
+      Allow_Alt_Model : Boolean   := True;
+      Assoc_Ent       : Entity_Id := Empty) return Uint
+   is
+      Btyp    : Entity_Id := Base_Type (Typ);
+      Def_Ent : Entity_Id;
+
+   begin
+      --  Ada 2005 (AI-230): For most cases of anonymous access types, we
+      --  simply use the level where the type is declared. This is true for
+      --  stand-alone object declarations, and for anonymous access types
+      --  associated with components the level is the same as that of the
+      --  enclosing composite type. However, special treatment is needed for
+      --  the cases of access parameters, return objects of an anonymous access
+      --  type, and, in Ada 95, access discriminants of limited types.
+
+      if Is_Access_Type (Btyp) then
+         if Ekind (Btyp) = E_Anonymous_Access_Type then
+            --  No_Dynamic_Accessibility_Checks restriction override for
+            --  alternative accessibility model.
+
+            if Allow_Alt_Model
+              and then No_Dynamic_Accessibility_Checks_Enabled (Btyp)
+            then
+               --  In the -gnatd_b model, the level of an anonymous access
+               --  type is always that of the designated type.
+
+               if Debug_Flag_Underscore_B then
+                  return Type_Access_Level
+                           (Designated_Type (Btyp), Allow_Alt_Model);
+               end if;
+
+               --  When an anonymous access type's Assoc_Ent is specified,
+               --  calculate the result based on the general accessibility
+               --  level routine.
+
+               --  We would like to use Associated_Node_For_Itype here instead,
+               --  but in some cases it is not fine grained enough ???
+
+               if Present (Assoc_Ent) then
+                  return Static_Accessibility_Level
+                           (Assoc_Ent, Object_Decl_Level);
+               end if;
+
+               --  Otherwise take the context of the anonymous access type into
+               --  account.
+
+               --  Obtain the defining entity for the internally generated
+               --  anonymous access type.
+
+               Def_Ent := Defining_Entity_Or_Empty
+                            (Associated_Node_For_Itype (Typ));
+
+               if Present (Def_Ent) then
+                  --  When the defining entity is a subprogram then we know the
+                  --  anonymous access type Typ has been generated to either
+                  --  describe an anonymous access type formal or an anonymous
+                  --  access result type.
+
+                  --  Since we are only interested in the formal case, avoid
+                  --  the anonymous access result type.
+
+                  if Is_Subprogram (Def_Ent)
+                    and then not (Ekind (Def_Ent) = E_Function
+                                   and then Etype (Def_Ent) = Typ)
+                  then
+                     --  When the type comes from an anonymous access
+                     --  parameter, the level is that of the subprogram
+                     --  declaration.
+
+                     return Scope_Depth (Def_Ent);
+
+                  --  When the type is an access discriminant, the level is
+                  --  that of the type.
+
+                  elsif Ekind (Def_Ent) = E_Discriminant then
+                     return Scope_Depth (Scope (Def_Ent));
+                  end if;
+               end if;
+
+            --  If the type is a nonlocal anonymous access type (such as for
+            --  an access parameter) we treat it as being declared at the
+            --  library level to ensure that names such as X.all'access don't
+            --  fail static accessibility checks.
+
+            elsif not Is_Local_Anonymous_Access (Typ) then
+               return Scope_Depth (Standard_Standard);
+
+            --  If this is a return object, the accessibility level is that of
+            --  the result subtype of the enclosing function. The test here is
+            --  little complicated, because we have to account for extended
+            --  return statements that have been rewritten as blocks, in which
+            --  case we have to find and the Is_Return_Object attribute of the
+            --  itype's associated object. It would be nice to find a way to
+            --  simplify this test, but it doesn't seem worthwhile to add a new
+            --  flag just for purposes of this test. ???
+
+            elsif Ekind (Scope (Btyp)) = E_Return_Statement
+              or else
+                (Is_Itype (Btyp)
+                  and then Nkind (Associated_Node_For_Itype (Btyp)) =
+                                                         N_Object_Declaration
+                  and then Is_Return_Object
+                             (Defining_Identifier
+                                (Associated_Node_For_Itype (Btyp))))
+            then
+               declare
+                  Scop : Entity_Id;
+
+               begin
+                  Scop := Scope (Scope (Btyp));
+                  while Present (Scop) loop
+                     exit when Ekind (Scop) = E_Function;
+                     Scop := Scope (Scop);
+                  end loop;
+
+                  --  Treat the return object's type as having the level of the
+                  --  function's result subtype (as per RM05-6.5(5.3/2)).
+
+                  return Type_Access_Level (Etype (Scop), Allow_Alt_Model);
+               end;
+            end if;
+         end if;
+
+         Btyp := Root_Type (Btyp);
+
+         --  The accessibility level of anonymous access types associated with
+         --  discriminants is that of the current instance of the type, and
+         --  that's deeper than the type itself (AARM 3.10.2 (12.3.21)).
+
+         --  AI-402: access discriminants have accessibility based on the
+         --  object rather than the type in Ada 2005, so the above paragraph
+         --  doesn't apply.
+
+         --  ??? Needs completion with rules from AI-416
+
+         if Ada_Version <= Ada_95
+           and then Ekind (Typ) = E_Anonymous_Access_Type
+           and then Present (Associated_Node_For_Itype (Typ))
+           and then Nkind (Associated_Node_For_Itype (Typ)) =
+                                                 N_Discriminant_Specification
+         then
+            return Scope_Depth (Enclosing_Dynamic_Scope (Btyp)) + 1;
+         end if;
+      end if;
+
+      --  Return library level for a generic formal type. This is done because
+      --  RM(10.3.2) says that "The statically deeper relationship does not
+      --  apply to ... a descendant of a generic formal type". Rather than
+      --  checking at each point where a static accessibility check is
+      --  performed to see if we are dealing with a formal type, this rule is
+      --  implemented by having Type_Access_Level and Deepest_Type_Access_Level
+      --  return extreme values for a formal type; Deepest_Type_Access_Level
+      --  returns Int'Last. By calling the appropriate function from among the
+      --  two, we ensure that the static accessibility check will pass if we
+      --  happen to run into a formal type. More specifically, we should call
+      --  Deepest_Type_Access_Level instead of Type_Access_Level whenever the
+      --  call occurs as part of a static accessibility check and the error
+      --  case is the case where the type's level is too shallow (as opposed
+      --  to too deep).
+
+      if Is_Generic_Type (Root_Type (Btyp)) then
+         return Scope_Depth (Standard_Standard);
+      end if;
+
+      return Scope_Depth (Enclosing_Dynamic_Scope (Btyp));
+   end Type_Access_Level;
+
+end Accessibility;
diff --git a/gcc/ada/accessibility.ads b/gcc/ada/accessibility.ads
new file mode 100644
index 00000000000..454ad759ec4
--- /dev/null
+++ b/gcc/ada/accessibility.ads
@@ -0,0 +1,222 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                        A C C E S S I B I L I T Y                         --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 2022-2022, Free Software Foundation, Inc.         --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Accessibility level and check generation routines
+
+with Types; use Types;
+with Uintp; use Uintp;
+
+package Accessibility is
+
+   procedure Accessibility_Message (N : Node_Id; Typ : Entity_Id);
+   --  Error, or warning within an instance, if the static accessibility
+   --  rules of 3.10.2 are violated.
+
+   type Accessibility_Level_Kind is
+     (Dynamic_Level,
+      Object_Decl_Level,
+      Zero_On_Dynamic_Level);
+   --  Accessibility_Level_Kind is an enumerated type which captures the
+   --  different modes in which an accessibility level could be obtained for
+   --  a given expression.
+
+   --  When in the context of the function Accessibility_Level,
+   --  Accessibility_Level_Kind signals what type of accessibility level to
+   --  obtain. For example, when Level is Dynamic_Level, a defining identifier
+   --  associated with a SAOOAAT may be returned or an N_Integer_Literal node.
+   --  When the level is Object_Decl_Level, an N_Integer_Literal node is
+   --  returned containing the level of the declaration of the object if
+   --  relevant (be it a SAOOAAT or otherwise). Finally, Zero_On_Dynamic_Level
+   --  returns library level for all cases where the accessibility level is
+   --  dynamic (used to bypass static accessibility checks in dynamic cases).
+
+   function Accessibility_Level
+     (Expr              : Node_Id;
+      Level             : Accessibility_Level_Kind;
+      In_Return_Context : Boolean := False;
+      Allow_Alt_Model   : Boolean := True) return Node_Id;
+   --  Centralized accessibility level calculation routine for finding the
+   --  accessibility level of a given expression Expr.
+
+   --  In_Return_Context forces the Accessibility_Level calculations to be
+   --  carried out "as if" Expr existed in a return value. This is useful for
+   --  calculating the accessibility levels for discriminant associations
+   --  and return aggregates.
+
+   --  The Allow_Alt_Model parameter allows the alternative level calculation
+   --  under the restriction No_Dynamic_Accessibility_Checks to be performed.
+
+   procedure Apply_Accessibility_Check
+     (N           : Node_Id;
+      Typ         : Entity_Id;
+      Insert_Node : Node_Id);
+   --  Given a name N denoting an access parameter, emits a run-time
+   --  accessibility check (if necessary), checking that the level of
+   --  the object denoted by the access parameter is not deeper than the
+   --  level of the type Typ. Program_Error is raised if the check fails.
+   --  Insert_Node indicates the node where the check should be inserted.
+
+   procedure Apply_Accessibility_Check_For_Allocator
+     (N              : Node_Id;
+      Exp            : Node_Id;
+      Ref            : Node_Id;
+      Built_In_Place : Boolean := False);
+   --  Ada 2005 (AI-344): For an allocator with a class-wide designated
+   --  type, generate an accessibility check to verify that the level of the
+   --  type of the created object is not deeper than the level of the access
+   --  type. If the type of the qualified expression is class-wide, then
+   --  always generate the check (except in the case where it is known to be
+   --  unnecessary, see comment below). Otherwise, only generate the check
+   --  if the level of the qualified expression type is statically deeper
+   --  than the access type.
+   --
+   --  Although the static accessibility will generally have been performed
+   --  as a legality check, it won't have been done in cases where the
+   --  allocator appears in generic body, so a run-time check is needed in
+   --  general. One special case is when the access type is declared in the
+   --  same scope as the class-wide allocator, in which case the check can
+   --  never fail, so it need not be generated.
+   --
+   --  As an open issue, there seem to be cases where the static level
+   --  associated with the class-wide object's underlying type is not
+   --  sufficient to perform the proper accessibility check, such as for
+   --  allocators in nested subprograms or accept statements initialized by
+   --  class-wide formals when the actual originates outside at a deeper
+   --  static level. The nested subprogram case might require passing
+   --  accessibility levels along with class-wide parameters, and the task
+   --  case seems to be an actual gap in the language rules that needs to
+   --  be fixed by the ARG. ???
+
+   procedure Check_Return_Construct_Accessibility
+     (Return_Stmt : Node_Id;
+      Stm_Entity  : Entity_Id);
+   --  Apply legality rule of 6.5 (5.9) to the access discriminants of an
+   --  aggregate in a return statement.
+
+   function Deepest_Type_Access_Level
+     (Typ             : Entity_Id;
+      Allow_Alt_Model : Boolean := True) return Uint;
+   --  Same as Type_Access_Level, except that if the type is the type of an Ada
+   --  2012 stand-alone object of an anonymous access type, then return the
+   --  static accessibility level of the object. In that case, the dynamic
+   --  accessibility level of the object may take on values in a range. The low
+   --  bound of that range is returned by Type_Access_Level; this function
+   --  yields the high bound of that range. Also differs from Type_Access_Level
+   --  in the case of a descendant of a generic formal type (returns Int'Last
+   --  instead of 0).
+
+   --  The Allow_Alt_Model parameter allows the alternative level calculation
+   --  under the restriction No_Dynamic_Accessibility_Checks to be performed.
+
+   function Effective_Extra_Accessibility (Id : Entity_Id) return Entity_Id;
+   --  Same as Einfo.Extra_Accessibility except thtat object renames
+   --  are looked through.
+
+   function Get_Dynamic_Accessibility (E : Entity_Id) return Entity_Id;
+   --  Obtain the accessibility level for a given entity formal taking into
+   --  account both extra and minimum accessibility.
+
+   function Has_Access_Values (T : Entity_Id) return Boolean;
+   --  Returns true if the underlying type of T is an access type, or has a
+   --  component (at any recursive level) that is an access type. This is a
+   --  conservative predicate, if it is not known whether or not T contains
+   --  access values (happens for generic formals in some cases), then False is
+   --  returned.  Note that tagged types return False. Even though the tag is
+   --  implemented as an access type internally, this function tests only for
+   --  access types known to the programmer. See also Has_Tagged_Component.
+
+   function Has_Anonymous_Access_Discriminant (Typ : Entity_Id) return Boolean;
+   --  Returns True if Typ has one or more anonymous access discriminants
+
+   function Prefix_With_Safe_Accessibility_Level
+     (N   : Node_Id;
+      Typ : Entity_Id) return Boolean;
+   --  Return True if the prefix does not have a value conversion of an
+   --  array because a value conversion is like an aggregate with respect
+   --  to determining accessibility level (RM 3.10.2); even if evaluation
+   --  of a value conversion is guaranteed to not create a new object,
+   --  accessibility rules are defined as if it might.
+
+   subtype Static_Accessibility_Level_Kind
+     is Accessibility_Level_Kind range Object_Decl_Level
+                                         .. Zero_On_Dynamic_Level;
+   --  Restrict the reange of Accessibility_Level_Kind to be non-dynamic for
+   --  use in the static version of Accessibility_Level below.
+
+   function Static_Accessibility_Level
+     (Expr              : Node_Id;
+      Level             : Static_Accessibility_Level_Kind;
+      In_Return_Context : Boolean := False) return Uint;
+   --  Overloaded version of Accessibility_Level which returns a universal
+   --  integer for use in compile-time checking. Note: Level is restricted to
+   --  be non-dynamic.
+
+   function Has_Unconstrained_Access_Discriminants
+     (Subtyp : Entity_Id) return Boolean;
+   --  Returns True if the given subtype is unconstrained and has one or more
+   --  access discriminants.
+
+   function Is_Anonymous_Access_Actual (N : Node_Id) return Boolean;
+   --  Determine if N is used as an actual for a call whose corresponding
+   --  formal is of an anonymous access type.
+
+   function Is_Special_Aliased_Formal_Access
+     (Exp               : Node_Id;
+      In_Return_Context : Boolean := False) return Boolean;
+   --  Determines whether a dynamic check must be generated for explicitly
+   --  aliased formals within a function Scop for the expression Exp.
+
+   --  In_Return_Context forces Is_Special_Aliased_Formal_Access to assume
+   --  that Exp is within a return value which is useful for checking
+   --  expressions within discriminant associations of return objects.
+
+   --  More specially, Is_Special_Aliased_Formal_Access checks that Exp is a
+   --  'Access attribute reference within a return statement where the ultimate
+   --  prefix is an aliased formal of Scop and that Scop returns an anonymous
+   --  access type. See RM 3.10.2 for more details.
+
+   function Needs_Result_Accessibility_Level
+     (Func_Id : Entity_Id) return Boolean;
+   --  Ada 2012 (AI05-0234): Return True if the function needs an implicit
+   --  parameter to identify the accessibility level of the function result
+   --  "determined by the point of call".
+
+   function Subprogram_Access_Level (Subp : Entity_Id) return Uint;
+   --  Return the accessibility level of the view denoted by Subp
+
+   function Type_Access_Level
+     (Typ             : Entity_Id;
+      Allow_Alt_Model : Boolean   := True;
+      Assoc_Ent       : Entity_Id := Empty) return Uint;
+   --  Return the accessibility level of Typ
+
+   --  The Allow_Alt_Model parameter allows the alternative level calculation
+   --  under the restriction No_Dynamic_Accessibility_Checks to be performed.
+
+   --  Assoc_Ent allows for the optional specification of the entity associated
+   --  with Typ. This gets utilized mostly for anonymous access type
+   --  processing, where context matters in interpreting Typ's level.
+
+end Accessibility;
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 2a45f4d49b0..5833be3a5de 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -570,119 +570,6 @@ package body Checks is
       Install_Null_Excluding_Check (P);
    end Apply_Access_Check;
 
-   -------------------------------
-   -- Apply_Accessibility_Check --
-   -------------------------------
-
-   procedure Apply_Accessibility_Check
-     (N           : Node_Id;
-      Typ         : Entity_Id;
-      Insert_Node : Node_Id)
-   is
-      Loc : constant Source_Ptr := Sloc (N);
-
-      Check_Cond  : Node_Id;
-      Param_Ent   : Entity_Id := Param_Entity (N);
-      Param_Level : Node_Id;
-      Type_Level  : Node_Id;
-
-   begin
-      --  Verify we haven't tried to add a dynamic accessibility check when we
-      --  shouldn't.
-
-      pragma Assert (not No_Dynamic_Accessibility_Checks_Enabled (N));
-
-      if Ada_Version >= Ada_2012
-         and then No (Param_Ent)
-         and then Is_Entity_Name (N)
-         and then Ekind (Entity (N)) in E_Constant | E_Variable
-         and then Present (Effective_Extra_Accessibility (Entity (N)))
-      then
-         Param_Ent := Entity (N);
-         while Present (Renamed_Object (Param_Ent)) loop
-            --  Renamed_Object must return an Entity_Name here
-            --  because of preceding "Present (E_E_A (...))" test.
-
-            Param_Ent := Entity (Renamed_Object (Param_Ent));
-         end loop;
-      end if;
-
-      if Inside_A_Generic then
-         return;
-
-      --  Only apply the run-time check if the access parameter has an
-      --  associated extra access level parameter and when accessibility checks
-      --  are enabled.
-
-      elsif Present (Param_Ent)
-         and then Present (Get_Dynamic_Accessibility (Param_Ent))
-         and then not Accessibility_Checks_Suppressed (Param_Ent)
-         and then not Accessibility_Checks_Suppressed (Typ)
-      then
-         --  Obtain the parameter's accessibility level
-
-         Param_Level :=
-           New_Occurrence_Of (Get_Dynamic_Accessibility (Param_Ent), Loc);
-
-         --  Use the dynamic accessibility parameter for the function's result
-         --  when one has been created instead of statically referring to the
-         --  deepest type level so as to appropriatly handle the rules for
-         --  RM 3.10.2 (10.1/3).
-
-         if Ekind (Scope (Param_Ent)) = E_Function
-           and then In_Return_Value (N)
-           and then Ekind (Typ) = E_Anonymous_Access_Type
-         then
-            --  Associate the level of the result type to the extra result
-            --  accessibility parameter belonging to the current function.
-
-            if Present (Extra_Accessibility_Of_Result (Scope (Param_Ent))) then
-               Type_Level :=
-                 New_Occurrence_Of
-                   (Extra_Accessibility_Of_Result (Scope (Param_Ent)), Loc);
-
-            --  In Ada 2005 and earlier modes, a result extra accessibility
-            --  parameter is not generated and no dynamic check is performed.
-
-            else
-               return;
-            end if;
-
-         --  Otherwise get the type's accessibility level normally
-
-         else
-            Type_Level :=
-              Make_Integer_Literal (Loc, Deepest_Type_Access_Level (Typ));
-         end if;
-
-         --  Raise Program_Error if the accessibility level of the access
-         --  parameter is deeper than the level of the target access type.
-
-         Check_Cond :=
-           Make_Op_Gt (Loc,
-             Left_Opnd  => Param_Level,
-             Right_Opnd => Type_Level);
-
-         Insert_Action (Insert_Node,
-           Make_Raise_Program_Error (Loc,
-             Condition => Check_Cond,
-             Reason    => PE_Accessibility_Check_Failed));
-
-         Analyze_And_Resolve (N);
-
-         --  If constant folding has happened on the condition for the
-         --  generated error, then warn about it being unconditional.
-
-         if Nkind (Check_Cond) = N_Identifier
-           and then Entity (Check_Cond) = Standard_True
-         then
-            Error_Msg_Warn := SPARK_Mode /= On;
-            Error_Msg_N ("accessibility check fails<<", N);
-            Error_Msg_N ("\Program_Error [<<", N);
-         end if;
-      end if;
-   end Apply_Accessibility_Check;
-
    --------------------------------
    -- Apply_Address_Clause_Check --
    --------------------------------
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index a7d05a3fa39..772adf00afa 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -189,16 +189,6 @@ package Checks is
    --  Determines whether an expression node requires a run-time access
    --  check and if so inserts the appropriate run-time check.
 
-   procedure Apply_Accessibility_Check
-     (N           : Node_Id;
-      Typ         : Entity_Id;
-      Insert_Node : Node_Id);
-   --  Given a name N denoting an access parameter, emits a run-time
-   --  accessibility check (if necessary), checking that the level of
-   --  the object denoted by the access parameter is not deeper than the
-   --  level of the type Typ. Program_Error is raised if the check fails.
-   --  Insert_Node indicates the node where the check should be inserted.
-
    procedure Apply_Address_Clause_Check (E : Entity_Id; N : Node_Id);
    --  E is the entity for an object which has an address clause. If checks
    --  are enabled, then this procedure generates a check that the specified
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 9c8d80ffe25..b7554e05f77 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Aspects;        use Aspects;
 with Atree;          use Atree;
 with Checks;         use Checks;
@@ -2215,13 +2216,25 @@ package body Exp_Attr is
 
             --  Local declarations
 
-            Enc_Object : constant Node_Id := Enclosing_Object (Ref_Object);
+            Enc_Object : Node_Id := Enclosing_Object (Ref_Object);
 
          --  Start of processing for Access_Cases
 
          begin
             Btyp_DDT := Designated_Type (Btyp);
 
+            --  When Enc_Object is a view conversion then RM 3.10.2 (9)
+            --  applies and we obtain the expression being converted.
+            --  Otherwise we do not dig any deeper since a conversion
+            --  might generate a copy and we can't assume it will be as
+            --  long-lived as the original.
+
+            while Nkind (Enc_Object) = N_Type_Conversion
+              and then Is_View_Conversion (Enc_Object)
+            loop
+               Enc_Object := Expression (Enc_Object);
+            end loop;
+
             --  Handle designated types that come from the limited view
 
             if From_Limited_With (Btyp_DDT)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 2661a3ff9f6..5050ec6eab5 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Aspects;        use Aspects;
 with Atree;          use Atree;
 with Checks;         use Checks;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 0a104cd8e23..00d19e765a6 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Aspects;        use Aspects;
 with Atree;          use Atree;
 with Checks;         use Checks;
@@ -33,7 +34,6 @@ with Einfo.Utils;    use Einfo.Utils;
 with Elists;         use Elists;
 with Errout;         use Errout;
 with Exp_Aggr;       use Exp_Aggr;
-with Exp_Atag;       use Exp_Atag;
 with Exp_Ch3;        use Exp_Ch3;
 with Exp_Ch6;        use Exp_Ch6;
 with Exp_Ch7;        use Exp_Ch7;
@@ -560,219 +560,6 @@ package body Exp_Ch4 is
       PtrT   : constant Entity_Id  := Etype (N);
       DesigT : constant Entity_Id  := Designated_Type (PtrT);
 
-      procedure Apply_Accessibility_Check
-        (Ref            : Node_Id;
-         Built_In_Place : Boolean := False);
-      --  Ada 2005 (AI-344): For an allocator with a class-wide designated
-      --  type, generate an accessibility check to verify that the level of the
-      --  type of the created object is not deeper than the level of the access
-      --  type. If the type of the qualified expression is class-wide, then
-      --  always generate the check (except in the case where it is known to be
-      --  unnecessary, see comment below). Otherwise, only generate the check
-      --  if the level of the qualified expression type is statically deeper
-      --  than the access type.
-      --
-      --  Although the static accessibility will generally have been performed
-      --  as a legality check, it won't have been done in cases where the
-      --  allocator appears in generic body, so a run-time check is needed in
-      --  general. One special case is when the access type is declared in the
-      --  same scope as the class-wide allocator, in which case the check can
-      --  never fail, so it need not be generated.
-      --
-      --  As an open issue, there seem to be cases where the static level
-      --  associated with the class-wide object's underlying type is not
-      --  sufficient to perform the proper accessibility check, such as for
-      --  allocators in nested subprograms or accept statements initialized by
-      --  class-wide formals when the actual originates outside at a deeper
-      --  static level. The nested subprogram case might require passing
-      --  accessibility levels along with class-wide parameters, and the task
-      --  case seems to be an actual gap in the language rules that needs to
-      --  be fixed by the ARG. ???
-
-      -------------------------------
-      -- Apply_Accessibility_Check --
-      -------------------------------
-
-      procedure Apply_Accessibility_Check
-        (Ref            : Node_Id;
-         Built_In_Place : Boolean := False)
-      is
-         Pool_Id   : constant Entity_Id := Associated_Storage_Pool (PtrT);
-         Cond      : Node_Id;
-         Fin_Call  : Node_Id;
-         Free_Stmt : Node_Id;
-         Obj_Ref   : Node_Id;
-         Stmts     : List_Id;
-
-      begin
-         if Ada_Version >= Ada_2005
-           and then Is_Class_Wide_Type (DesigT)
-           and then Tagged_Type_Expansion
-           and then not Scope_Suppress.Suppress (Accessibility_Check)
-           and then not No_Dynamic_Accessibility_Checks_Enabled (Ref)
-           and then
-             (Type_Access_Level (Etype (Exp)) > Type_Access_Level (PtrT)
-               or else
-                 (Is_Class_Wide_Type (Etype (Exp))
-                   and then Scope (PtrT) /= Current_Scope))
-         then
-            --  If the allocator was built in place, Ref is already a reference
-            --  to the access object initialized to the result of the allocator
-            --  (see Exp_Ch6.Make_Build_In_Place_Call_In_Allocator). We call
-            --  Remove_Side_Effects for cases where the build-in-place call may
-            --  still be the prefix of the reference (to avoid generating
-            --  duplicate calls). Otherwise, it is the entity associated with
-            --  the object containing the address of the allocated object.
-
-            if Built_In_Place then
-               Remove_Side_Effects (Ref);
-               Obj_Ref := New_Copy_Tree (Ref);
-            else
-               Obj_Ref := New_Occurrence_Of (Ref, Loc);
-            end if;
-
-            --  For access to interface types we must generate code to displace
-            --  the pointer to the base of the object since the subsequent code
-            --  references components located in the TSD of the object (which
-            --  is associated with the primary dispatch table --see a-tags.ads)
-            --  and also generates code invoking Free, which requires also a
-            --  reference to the base of the unallocated object.
-
-            if Is_Interface (DesigT) and then Tagged_Type_Expansion then
-               Obj_Ref :=
-                 Unchecked_Convert_To (Etype (Obj_Ref),
-                   Make_Function_Call (Loc,
-                     Name                   =>
-                       New_Occurrence_Of (RTE (RE_Base_Address), Loc),
-                     Parameter_Associations => New_List (
-                       Unchecked_Convert_To (RTE (RE_Address),
-                         New_Copy_Tree (Obj_Ref)))));
-            end if;
-
-            --  Step 1: Create the object clean up code
-
-            Stmts := New_List;
-
-            --  Deallocate the object if the accessibility check fails. This
-            --  is done only on targets or profiles that support deallocation.
-
-            --    Free (Obj_Ref);
-
-            if RTE_Available (RE_Free) then
-               Free_Stmt := Make_Free_Statement (Loc, New_Copy_Tree (Obj_Ref));
-               Set_Storage_Pool (Free_Stmt, Pool_Id);
-
-               Append_To (Stmts, Free_Stmt);
-
-            --  The target or profile cannot deallocate objects
-
-            else
-               Free_Stmt := Empty;
-            end if;
-
-            --  Finalize the object if applicable. Generate:
-
-            --    [Deep_]Finalize (Obj_Ref.all);
-
-            if Needs_Finalization (DesigT)
-              and then not No_Heap_Finalization (PtrT)
-            then
-               Fin_Call :=
-                 Make_Final_Call
-                   (Obj_Ref =>
-                      Make_Explicit_Dereference (Loc, New_Copy (Obj_Ref)),
-                    Typ     => DesigT);
-
-               --  Guard against a missing [Deep_]Finalize when the designated
-               --  type was not properly frozen.
-
-               if No (Fin_Call) then
-                  Fin_Call := Make_Null_Statement (Loc);
-               end if;
-
-               --  When the target or profile supports deallocation, wrap the
-               --  finalization call in a block to ensure proper deallocation
-               --  even if finalization fails. Generate:
-
-               --    begin
-               --       <Fin_Call>
-               --    exception
-               --       when others =>
-               --          <Free_Stmt>
-               --          raise;
-               --    end;
-
-               if Present (Free_Stmt) then
-                  Fin_Call :=
-                    Make_Block_Statement (Loc,
-                      Handled_Statement_Sequence =>
-                        Make_Handled_Sequence_Of_Statements (Loc,
-                          Statements => New_List (Fin_Call),
-
-                        Exception_Handlers => New_List (
-                          Make_Exception_Handler (Loc,
-                            Exception_Choices => New_List (
-                              Make_Others_Choice (Loc)),
-                            Statements        => New_List (
-                              New_Copy_Tree (Free_Stmt),
-                              Make_Raise_Statement (Loc))))));
-               end if;
-
-               Prepend_To (Stmts, Fin_Call);
-            end if;
-
-            --  Signal the accessibility failure through a Program_Error
-
-            Append_To (Stmts,
-              Make_Raise_Program_Error (Loc,
-                Reason => PE_Accessibility_Check_Failed));
-
-            --  Step 2: Create the accessibility comparison
-
-            --  Generate:
-            --    Ref'Tag
-
-            Obj_Ref :=
-              Make_Attribute_Reference (Loc,
-                Prefix         => Obj_Ref,
-                Attribute_Name => Name_Tag);
-
-            --  For tagged types, determine the accessibility level by looking
-            --  at the type specific data of the dispatch table. Generate:
-
-            --    Type_Specific_Data (Address (Ref'Tag)).Access_Level
-
-            if Tagged_Type_Expansion then
-               Cond := Build_Get_Access_Level (Loc, Obj_Ref);
-
-            --  Use a runtime call to determine the accessibility level when
-            --  compiling on virtual machine targets. Generate:
-
-            --    Get_Access_Level (Ref'Tag)
-
-            else
-               Cond :=
-                 Make_Function_Call (Loc,
-                   Name                   =>
-                     New_Occurrence_Of (RTE (RE_Get_Access_Level), Loc),
-                   Parameter_Associations => New_List (Obj_Ref));
-            end if;
-
-            Cond :=
-              Make_Op_Gt (Loc,
-                Left_Opnd  => Cond,
-                Right_Opnd => Accessibility_Level (N, Dynamic_Level));
-
-            --  Due to the complexity and side effects of the check, utilize an
-            --  if statement instead of the regular Program_Error circuitry.
-
-            Insert_Action (N,
-              Make_Implicit_If_Statement (N,
-                Condition       => Cond,
-                Then_Statements => Stmts));
-         end if;
-      end Apply_Accessibility_Check;
-
       --  Local variables
 
       Indic         : constant Node_Id   := Subtype_Mark (Expression (N));
@@ -884,7 +671,8 @@ package body Exp_Ch4 is
 
          if Is_Build_In_Place_Function_Call (Exp) then
             Make_Build_In_Place_Call_In_Allocator (N, Exp);
-            Apply_Accessibility_Check (N, Built_In_Place => True);
+            Apply_Accessibility_Check_For_Allocator
+              (N, Exp, N, Built_In_Place => True);
             return;
 
          --  Ada 2005 (AI-318-02): Specialization of the previous case for
@@ -896,7 +684,8 @@ package body Exp_Ch4 is
 
          elsif Present (Unqual_BIP_Iface_Function_Call (Exp)) then
             Make_Build_In_Place_Iface_Call_In_Allocator (N, Exp);
-            Apply_Accessibility_Check (N, Built_In_Place => True);
+            Apply_Accessibility_Check_For_Allocator
+              (N, Exp, N, Built_In_Place => True);
             return;
          end if;
 
@@ -1191,7 +980,7 @@ package body Exp_Ch4 is
          --  Note: the accessibility check must be inserted after the call to
          --  [Deep_]Adjust to ensure proper completion of the assignment.
 
-         Apply_Accessibility_Check (Temp);
+         Apply_Accessibility_Check_For_Allocator (N, Exp, Temp);
 
          Rewrite (N, New_Occurrence_Of (Temp, Loc));
          Analyze_And_Resolve (N, PtrT);
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 3ea6cbbd3e8..d67f788ab78 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Aspects;        use Aspects;
 with Atree;          use Atree;
 with Checks;         use Checks;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 0fe980c499a..ae59ad7017d 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Atree;          use Atree;
 with Aspects;        use Aspects;
 with Checks;         use Checks;
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 70ede15901e..7d76144ceff 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Atree;          use Atree;
 with Aspects;        use Aspects;
 with Checks;         use Checks;
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 41da7a23ee5..e0ad27e0677 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Atree;          use Atree;
 with Checks;         use Checks;
 with Debug;          use Debug;
diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in
index 45a4168e890..2acd195017e 100644
--- a/gcc/ada/gcc-interface/Make-lang.in
+++ b/gcc/ada/gcc-interface/Make-lang.in
@@ -399,6 +399,7 @@ GNAT_ADA_OBJS =	\
  ada/sem_ch12.o	\
  ada/sem_ch13.o	\
  ada/sem_ch2.o	\
+ ada/accessibility.o	\
  ada/sem_ch3.o	\
  ada/sem_ch4.o	\
  ada/sem_ch5.o	\
diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index 83c71800b5a..e0dba9e6a5c 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -98,6 +98,7 @@ package Gen_IL.Fields is
       Cleanup_Actions,
       Comes_From_Check_Or_Contract,
       Comes_From_Extended_Return_Statement,
+      Comes_From_Iterator,
       Compile_Time_Known_Aggregate,
       Component_Associations,
       Component_Clauses,
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index 556326a3e61..ba4539140fe 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -906,6 +906,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
         Sy (Subtype_Mark, Node_Id, Default_Empty),
         Sy (Access_Definition, Node_Id, Default_Empty),
         Sy (Name, Node_Id, Default_Empty),
+        Sm (Comes_From_Iterator, Flag),
         Sm (Corresponding_Generic_Association, Node_Id)));
 
    Cc (N_Package_Renaming_Declaration, N_Renaming_Declaration,
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 3e978f93c46..433f1ac84ca 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3242,7 +3242,7 @@ package body Sem_Aggr is
             end loop;
          end;
 
-      else
+      elsif Present (Assign_Indexed_Subp) then
          --  Indexed Aggregate. Positional or indexed component
          --  can be present, but not both. Choices must be static
          --  values or ranges with static bounds.
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index cca6f6f8c7d..7c76f0fef0a 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -25,6 +25,7 @@
 
 with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
 
+with Accessibility;  use Accessibility;
 with Aspects;        use Aspects;
 with Atree;          use Atree;
 with Casing;         use Casing;
@@ -10936,72 +10937,12 @@ package body Sem_Attr is
       It       : Interp;
       Nom_Subt : Entity_Id;
 
-      procedure Accessibility_Message;
-      --  Error, or warning within an instance, if the static accessibility
-      --  rules of 3.10.2 are violated.
-
       function Declared_Within_Generic_Unit
         (Entity       : Entity_Id;
          Generic_Unit : Node_Id) return Boolean;
       --  Returns True if Declared_Entity is declared within the declarative
       --  region of Generic_Unit; otherwise returns False.
 
-      function Prefix_With_Safe_Accessibility_Level return Boolean;
-      --  Return True if the prefix does not have a value conversion of an
-      --  array because a value conversion is like an aggregate with respect
-      --  to determining accessibility level (RM 3.10.2); even if evaluation
-      --  of a value conversion is guaranteed to not create a new object,
-      --  accessibility rules are defined as if it might.
-
-      ---------------------------
-      -- Accessibility_Message --
-      ---------------------------
-
-      procedure Accessibility_Message is
-         Indic : Node_Id := Parent (Parent (N));
-
-      begin
-         --  In an instance, this is a runtime check, but one we
-         --  know will fail, so generate an appropriate warning.
-
-         if In_Instance_Body then
-            Error_Msg_Warn := SPARK_Mode /= On;
-            Error_Msg_F
-              ("non-local pointer cannot point to local object<<", P);
-            Error_Msg_F ("\Program_Error [<<", P);
-            Rewrite (N,
-              Make_Raise_Program_Error (Loc,
-                Reason => PE_Accessibility_Check_Failed));
-            Set_Etype (N, Typ);
-            return;
-
-         else
-            Error_Msg_F ("non-local pointer cannot point to local object", P);
-
-            --  Check for case where we have a missing access definition
-
-            if Is_Record_Type (Current_Scope)
-              and then
-                Nkind (Parent (N)) in N_Discriminant_Association
-                                    | N_Index_Or_Discriminant_Constraint
-            then
-               Indic := Parent (Parent (N));
-               while Present (Indic)
-                 and then Nkind (Indic) /= N_Subtype_Indication
-               loop
-                  Indic := Parent (Indic);
-               end loop;
-
-               if Present (Indic) then
-                  Error_Msg_NE
-                    ("\use an access definition for" &
-                     " the access discriminant of&",
-                     N, Entity (Subtype_Mark (Indic)));
-               end if;
-            end if;
-         end if;
-      end Accessibility_Message;
-
       ----------------------------------
       -- Declared_Within_Generic_Unit --
       ----------------------------------
@@ -11029,70 +10970,6 @@ package body Sem_Attr is
          return False;
       end Declared_Within_Generic_Unit;
 
-      ------------------------------------------
-      -- Prefix_With_Safe_Accessibility_Level --
-      ------------------------------------------
-
-      function Prefix_With_Safe_Accessibility_Level return Boolean is
-         function Safe_Value_Conversions return Boolean;
-         --  Return False if the prefix has a value conversion of an array type
-
-         ----------------------------
-         -- Safe_Value_Conversions --
-         ----------------------------
-
-         function Safe_Value_Conversions return Boolean is
-            PP : Node_Id := P;
-
-         begin
-            loop
-               if Nkind (PP) in N_Selected_Component | N_Indexed_Component then
-                  PP := Prefix (PP);
-
-               elsif Comes_From_Source (PP)
-                 and then Nkind (PP) in N_Type_Conversion
-                                      | N_Unchecked_Type_Conversion
-                 and then Is_Array_Type (Etype (PP))
-               then
-                  return False;
-
-               elsif Comes_From_Source (PP)
-                 and then Nkind (PP) = N_Qualified_Expression
-                 and then Is_Array_Type (Etype (PP))
-                 and then Nkind (Original_Node (Expression (PP))) in
-                            N_Aggregate | N_Extension_Aggregate
-               then
-                  return False;
-
-               else
-                  exit;
-               end if;
-            end loop;
-
-            return True;
-         end Safe_Value_Conversions;
-
-      --  Start of processing for Prefix_With_Safe_Accessibility_Level
-
-      begin
-         --  No check required for unchecked and unrestricted access
-
-         if Attr_Id = Attribute_Unchecked_Access
-           or else Attr_Id = Attribute_Unrestricted_Access
-         then
-            return True;
-
-         --  Check value conversions
-
-         elsif Ekind (Btyp) = E_General_Access_Type
-           and then not Safe_Value_Conversions
-         then
-            return False;
-         end if;
-
-         return True;
-      end Prefix_With_Safe_Accessibility_Level;
-
    --  Start of processing for Resolve_Attribute
 
    begin
@@ -11778,7 +11655,7 @@ package body Sem_Attr is
                       Intval (Accessibility_Level (P, Dynamic_Level))
                         > Deepest_Type_Access_Level (Btyp)
                   then
-                     Accessibility_Message;
+                     Accessibility_Message (N, Typ);
                      return;
                   end if;
                end;
@@ -11804,7 +11681,7 @@ package body Sem_Attr is
                  and then Ekind (Btyp) = E_Access_Protected_Subprogram_Type
                  and then Attr_Id /= Attribute_Unrestricted_Access
                then
-                  Accessibility_Message;
+                  Accessibility_Message (N, Typ);
                   return;
 
                --  AI05-0225: If the context is not an access to protected
@@ -11963,8 +11840,8 @@ package body Sem_Attr is
             --  array type since a value conversion is like an aggregate with
             --  respect to determining accessibility level (RM 3.10.2).
 
-            if not Prefix_With_Safe_Accessibility_Level then
-               Accessibility_Message;
+            if not Prefix_With_Safe_Accessibility_Level (N, Typ) then
+               Accessibility_Message (N, Typ);
                return;
             end if;
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 71eabb4f627..618f935e4fe 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;    use Accessibility;
 with Aspects;          use Aspects;
 with Atree;            use Atree;
 with Checks;           use Checks;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 61386e27feb..abee91f27fd 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Aspects;        use Aspects;
 with Atree;          use Atree;
 with Checks;         use Checks;
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index b724fbe57a6..c8c0d80ffcd 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Aspects;        use Aspects;
 with Atree;          use Atree;
 with Debug;          use Debug;
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index b54f2708c8d..c1523ae11e2 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2523,6 +2523,7 @@ package body Sem_Ch5 is
                 Subtype_Mark        => New_Occurrence_Of (Typ, Loc),
                 Name                =>
                   New_Copy_Tree (Iter_Name, New_Sloc => Loc));
+            Set_Comes_From_Iterator (Decl);
 
             Insert_Actions (Parent (Parent (N)), New_List (Decl));
             Rewrite (Name (N), New_Occurrence_Of (Id, Loc));
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index cb982b376a5..d567f79b27e 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Aspects;        use Aspects;
 with Atree;          use Atree;
 with Checks;         use Checks;
@@ -745,10 +746,6 @@ package body Sem_Ch6 is
       --  Ada 2022: Check that the return expression in a No_Return function
       --  meets the conditions specified by RM 6.5.1(5.1/5).
 
-      procedure Check_Return_Construct_Accessibility (Return_Stmt : Node_Id);
-      --  Apply legality rule of 6.5 (5.9) to the access discriminants of an
-      --  aggregate in a return statement.
-
       procedure Check_Return_Subtype_Indication (Obj_Decl : Node_Id);
       --  Check that the return_subtype_indication properly matches the result
       --  subtype of the function, as required by RM-6.5(5.1/2-5.3/2).
@@ -781,516 +778,6 @@ package body Sem_Ch6 is
             Return_Expr);
       end Check_No_Return_Expression;
 
-      ------------------------------------------
-      -- Check_Return_Construct_Accessibility --
-      ------------------------------------------
-
-      procedure Check_Return_Construct_Accessibility (Return_Stmt : Node_Id) is
-
-         function First_Selector (Assoc : Node_Id) return Node_Id;
-         --  Obtain the first selector or choice from a given association
-
-         function Is_Formal_Of_Current_Function
-           (Assoc_Expr : Entity_Id) return Boolean;
-         --  Predicate to test if a given expression associated with a
-         --  discriminant is a formal parameter to the function in which the
-         --  return construct we checking applies to.
-
-         --------------------
-         -- First_Selector --
-         --------------------
-
-         function First_Selector (Assoc : Node_Id) return Node_Id is
-         begin
-            if Nkind (Assoc) = N_Component_Association then
-               return First (Choices (Assoc));
-
-            elsif Nkind (Assoc) = N_Discriminant_Association then
-               return (First (Selector_Names (Assoc)));
-
-            else
-               raise Program_Error;
-            end if;
-         end First_Selector;
-
-         -----------------------------------
-         -- Is_Formal_Of_Current_Function --
-         -----------------------------------
-
-         function Is_Formal_Of_Current_Function
-           (Assoc_Expr : Entity_Id) return Boolean is
-         begin
-            return Is_Entity_Name (Assoc_Expr)
-                     and then Enclosing_Subprogram
-                                (Entity (Assoc_Expr)) = Scope_Id
-                     and then Is_Formal (Entity (Assoc_Expr));
-         end Is_Formal_Of_Current_Function;
-
-         --  Local declarations
-
-         Assoc : Node_Id := Empty;
-         --  Assoc should perhaps be renamed and declared as a
-         --  Node_Or_Entity_Id since it encompasses not only component and
-         --  discriminant associations, but also discriminant components within
-         --  a type declaration or subtype indication ???
-
-         Assoc_Expr    : Node_Id;
-         Assoc_Present : Boolean := False;
-
-         Check_Cond        : Node_Id;
-         Unseen_Disc_Count : Nat := 0;
-         Seen_Discs        : Elist_Id;
-         Disc              : Entity_Id;
-         First_Disc        : Entity_Id;
-
-         Obj_Decl   : Node_Id;
-         Return_Con : Node_Id;
-         Unqual     : Node_Id;
-
-      --  Start of processing for Check_Return_Construct_Accessibility
-
-      begin
-         --  Only perform checks on record types with access discriminants and
-         --  non-internally generated functions.
-
-         if not Is_Record_Type (R_Type)
-           or else not Has_Anonymous_Access_Discriminant (R_Type)
-           or else not Comes_From_Source (Return_Stmt)
-         then
-            return;
-         end if;
-
-         --  We are only interested in return statements
-
-         if Nkind (Return_Stmt) not in
-              N_Extended_Return_Statement | N_Simple_Return_Statement
-         then
-            return;
-         end if;
-
-         --  Fetch the object from the return statement, in the case of a
-         --  simple return statement the expression is part of the node.
-
-         if Nkind (Return_Stmt) = N_Extended_Return_Statement then
-            --  Obtain the object definition from the expanded extended return
-
-            Return_Con := First (Return_Object_Declarations (Return_Stmt));
-            while Present (Return_Con) loop
-               --  Inspect the original node to avoid object declarations
-               --  expanded into renamings.
-
-               if Nkind (Original_Node (Return_Con)) = N_Object_Declaration
-                 and then Comes_From_Source (Original_Node (Return_Con))
-               then
-                  exit;
-               end if;
-
-               Nlists.Next (Return_Con);
-            end loop;
-
-            pragma Assert (Present (Return_Con));
-
-            --  Could be dealing with a renaming
-
-            Return_Con := Original_Node (Return_Con);
-         else
-            Return_Con := Expression (Return_Stmt);
-         end if;
-
-         --  Obtain the accessibility levels of the expressions associated
-         --  with all anonymous access discriminants, then generate a
-         --  dynamic check or static error when relevant.
-
-         --  Note the repeated use of Original_Node to avoid checking
-         --  expanded code.
-
-         Unqual := Original_Node (Unqualify (Original_Node (Return_Con)));
-
-         --  Get the corresponding declaration based on the return object's
-         --  identifier.
-
-         if Nkind (Unqual) = N_Identifier
-           and then Nkind (Parent (Entity (Unqual)))
-                      in N_Object_Declaration
-                       | N_Object_Renaming_Declaration
-         then
-            Obj_Decl := Original_Node (Parent (Entity (Unqual)));
-
-         --  We were passed the object declaration directly, so use it
-
-         elsif Nkind (Unqual) in N_Object_Declaration
-                               | N_Object_Renaming_Declaration
-         then
-            Obj_Decl := Unqual;
-
-         --  Otherwise, we are looking at something else
-
-         else
-            Obj_Decl := Empty;
-
-         end if;
-
-         --  Hop up object renamings when present
-
-         if Present (Obj_Decl)
-           and then Nkind (Obj_Decl) = N_Object_Renaming_Declaration
-         then
-            while Nkind (Obj_Decl) = N_Object_Renaming_Declaration loop
-
-               if Nkind (Name (Obj_Decl)) not in N_Entity then
-                  --  We may be looking at the expansion of iterators or
-                  --  some other internally generated construct, so it is safe
-                  --  to ignore checks ???
-
-                  if not Comes_From_Source (Obj_Decl) then
-                     return;
-                  end if;
-
-                  Obj_Decl := Original_Node
-                                (Declaration_Node
-                                  (Ultimate_Prefix (Name (Obj_Decl))));
-
-               --  Move up to the next declaration based on the object's name
-
-               else
-                  Obj_Decl := Original_Node
-                                (Declaration_Node (Name (Obj_Decl)));
-               end if;
-            end loop;
-         end if;
-
-         --  Obtain the discriminant values from the return aggregate
-
-         --  Do we cover extension aggregates correctly ???
-
-         if Nkind (Unqual) = N_Aggregate then
-            if Present (Expressions (Unqual)) then
-               Assoc := First (Expressions (Unqual));
-            else
-               Assoc := First (Component_Associations (Unqual));
-            end if;
-
-         --  There is an object declaration for the return object
-
-         elsif Present (Obj_Decl) then
-            --  When a subtype indication is present in an object declaration
-            --  it must contain the object's discriminants.
-
-            if Nkind (Object_Definition (Obj_Decl)) = N_Subtype_Indication then
-               Assoc := First
-                          (Constraints
-                            (Constraint
-                              (Object_Definition (Obj_Decl))));
-
-            --  The object declaration contains an aggregate
-
-            elsif Present (Expression (Obj_Decl)) then
-
-               if Nkind (Unqualify (Expression (Obj_Decl))) = N_Aggregate then
-                  --  Grab the first associated discriminant expresion
-
-                  if Present
-                       (Expressions (Unqualify (Expression (Obj_Decl))))
-                  then
-                     Assoc := First
-                                (Expressions
-                                  (Unqualify (Expression (Obj_Decl))));
-                  else
-                     Assoc := First
-                                (Component_Associations
-                                  (Unqualify (Expression (Obj_Decl))));
-                  end if;
-
-               --  Otherwise, this is something else
-
-               else
-                  return;
-               end if;
-
-            --  There are no supplied discriminants in the object declaration,
-            --  so get them from the type definition since they must be default
-            --  initialized.
-
-            --  Do we handle constrained subtypes correctly ???
-
-            elsif Nkind (Unqual) = N_Object_Declaration then
-               Assoc := First_Discriminant
-                          (Etype (Object_Definition (Obj_Decl)));
-
-            else
-               Assoc := First_Discriminant (Etype (Unqual));
-            end if;
-
-         --  When we are not looking at an aggregate or an identifier, return
-         --  since any other construct (like a function call) is not
-         --  applicable since checks will be performed on the side of the
-         --  callee.
-
-         else
-            return;
-         end if;
-
-         --  Obtain the discriminants so we know the actual type in case the
-         --  value of their associated expression gets implicitly converted.
-
-         if No (Obj_Decl) then
-            pragma Assert (Nkind (Unqual) = N_Aggregate);
-
-            Disc := First_Discriminant (Etype (Unqual));
-
-         else
-            Disc := First_Discriminant
-                      (Etype (Defining_Identifier (Obj_Decl)));
-         end if;
-
-         --  Preserve the first discriminant for checking named associations
-
-         First_Disc := Disc;
-
-         --  Count the number of discriminants for processing an aggregate
-         --  which includes an others.
-
-         Disc := First_Disc;
-         while Present (Disc) loop
-            Unseen_Disc_Count := Unseen_Disc_Count + 1;
-
-            Next_Discriminant (Disc);
-         end loop;
-
-         Seen_Discs := New_Elmt_List;
-
-         --  Loop through each of the discriminants and check each expression
-         --  associated with an anonymous access discriminant.
-
-         --  When named associations occur in the return aggregate then
-         --  discriminants can be in any order, so we need to ensure we do
-         --  not continue to loop when all discriminants have been seen.
-
-         Disc := First_Disc;
-         while Present (Assoc)
-           and then (Present (Disc) or else Assoc_Present)
-           and then Unseen_Disc_Count > 0
-         loop
-            --  Handle named associations by searching through the names of
-            --  the relevant discriminant components.
-
-            if Nkind (Assoc)
-                 in N_Component_Association | N_Discriminant_Association
-            then
-               Assoc_Expr    := Expression (Assoc);
-               Assoc_Present := True;
-
-               --  We currently don't handle box initialized discriminants,
-               --  however, since default initialized anonymous access
-               --  discriminants are a corner case, this is ok for now ???
-
-               if Nkind (Assoc) = N_Component_Association
-                 and then Box_Present (Assoc)
-               then
-                  if Nkind (First_Selector (Assoc)) = N_Others_Choice then
-                     Unseen_Disc_Count := 0;
-                  end if;
-
-               --  When others is present we must identify a discriminant we
-               --  haven't already seen so as to get the appropriate type for
-               --  the static accessibility check.
-
-               --  This works because all components within an others clause
-               --  must have the same type.
-
-               elsif Nkind (First_Selector (Assoc)) = N_Others_Choice then
-
-                  Disc := First_Disc;
-                  Outer : while Present (Disc) loop
-                     declare
-                        Current_Seen_Disc : Elmt_Id;
-                     begin
-                        --  Move through the list of identified discriminants
-
-                        Current_Seen_Disc := First_Elmt (Seen_Discs);
-                        while Present (Current_Seen_Disc) loop
-                           --  Exit the loop when we found a match
-
-                           exit when
-                             Chars (Node (Current_Seen_Disc)) = Chars (Disc);
-
-                           Next_Elmt (Current_Seen_Disc);
-                        end loop;
-
-                        --  When we have exited the above loop without finding
-                        --  a match then we know that Disc has not been seen.
-
-                        exit Outer when No (Current_Seen_Disc);
-                     end;
-
-                     Next_Discriminant (Disc);
-                  end loop Outer;
-
-                  --  If we got to an others clause with a non-zero
-                  --  discriminant count there must be a discriminant left to
-                  --  check.
-
-                  pragma Assert (Present (Disc));
-
-                  --  Set the unseen discriminant count to zero because we know
-                  --  an others clause sets all remaining components of an
-                  --  aggregate.
-
-                  Unseen_Disc_Count := 0;
-
-               --  Move through each of the selectors in the named association
-               --  and obtain a discriminant for accessibility checking if one
-               --  is referenced in the list. Also track which discriminants
-               --  are referenced for the purpose of handling an others clause.
-
-               else
-                  declare
-                     Assoc_Choice : Node_Id;
-                     Curr_Disc    : Node_Id;
-                  begin
-
-                     Disc      := Empty;
-                     Curr_Disc := First_Disc;
-                     while Present (Curr_Disc) loop
-                        --  Check each of the choices in the associations for a
-                        --  match to the name of the current discriminant.
-
-                        Assoc_Choice := First_Selector (Assoc);
-                        while Present (Assoc_Choice) loop
-                           --  When the name matches we track that we have seen
-                           --  the discriminant, but instead of exiting the
-                           --  loop we continue iterating to make sure all the
-                           --  discriminants within the named association get
-                           --  tracked.
-
-                           if Chars (Assoc_Choice) = Chars (Curr_Disc) then
-                              Append_Elmt (Curr_Disc, Seen_Discs);
-
-                              Disc              := Curr_Disc;
-                              Unseen_Disc_Count := Unseen_Disc_Count - 1;
-                           end if;
-
-                           Next (Assoc_Choice);
-                        end loop;
-
-                        Next_Discriminant (Curr_Disc);
-                     end loop;
-                  end;
-               end if;
-
-            --  Unwrap the associated expression if we are looking at a default
-            --  initialized type declaration. In this case Assoc is not really
-            --  an association, but a component declaration. Should Assoc be
-            --  renamed in some way to be more clear ???
-
-            --  This occurs when the return object does not initialize
-            --  discriminant and instead relies on the type declaration for
-            --  their supplied values.
-
-            elsif Nkind (Assoc) in N_Entity
-              and then Ekind (Assoc) = E_Discriminant
-            then
-               Append_Elmt (Disc, Seen_Discs);
-
-               Assoc_Expr        := Discriminant_Default_Value (Assoc);
-               Unseen_Disc_Count := Unseen_Disc_Count - 1;
-
-            --  Otherwise, there is nothing to do because Assoc is an
-            --  expression within the return aggregate itself.
-
-            else
-               Append_Elmt (Disc, Seen_Discs);
-
-               Assoc_Expr        := Assoc;
-               Unseen_Disc_Count := Unseen_Disc_Count - 1;
-            end if;
-
-            --  Check the accessibility level of the expression when the
-            --  discriminant is of an anonymous access type.
-
-            if Present (Assoc_Expr)
-              and then Present (Disc)
-              and then Ekind (Etype (Disc)) = E_Anonymous_Access_Type
-
-              --  We disable the check when we have a tagged return type and
-              --  the associated expression for the discriminant is a formal
-              --  parameter since the check would require us to compare the
-              --  accessibility level of Assoc_Expr to the level of the
-              --  Extra_Accessibility_Of_Result of the function - which is
-              --  currently disabled for functions with tagged return types.
-              --  This may change in the future ???
-
-              --  See Needs_Result_Accessibility_Level for details.
-
-              and then not
-                (No (Extra_Accessibility_Of_Result (Scope_Id))
-                  and then Is_Formal_Of_Current_Function (Assoc_Expr)
-                  and then Is_Tagged_Type (Etype (Scope_Id)))
-            then
-               --  Generate a dynamic check based on the extra accessibility of
-               --  the result or the scope of the current function.
-
-               Check_Cond :=
-                 Make_Op_Gt (Loc,
-                   Left_Opnd  => Accessibility_Level
-                                   (Expr              => Assoc_Expr,
-                                    Level             => Dynamic_Level,
-                                    In_Return_Context => True),
-                   Right_Opnd =>
-                     (if Present (Extra_Accessibility_Of_Result (Scope_Id))
-
-                        --  When Assoc_Expr is a formal we have to look at the
-                        --  extra accessibility-level formal associated with
-                        --  the result.
-
-                        and then Is_Formal_Of_Current_Function (Assoc_Expr)
-                      then
-                         New_Occurrence_Of
-                           (Extra_Accessibility_Of_Result (Scope_Id), Loc)
-
-                      --  Otherwise, we compare the level of Assoc_Expr to the
-                      --  scope of the current function.
-
-                      else
-                         Make_Integer_Literal
-                           (Loc, Scope_Depth (Scope (Scope_Id)))));
-
-               Insert_Before_And_Analyze (Return_Stmt,
-                 Make_Raise_Program_Error (Loc,
-                   Condition => Check_Cond,
-                   Reason    => PE_Accessibility_Check_Failed));
-
-               --  If constant folding has happened on the condition for the
-               --  generated error, then warn about it being unconditional when
-               --  we know an error will be raised.
-
-               if Nkind (Check_Cond) = N_Identifier
-                 and then Entity (Check_Cond) = Standard_True
-               then
-                  Error_Msg_N
-                    ("access discriminant in return object would be a dangling"
-                     & " reference", Return_Stmt);
-               end if;
-            end if;
-
-            --  Iterate over the discriminants, except when we have encountered
-            --  a named association since the discriminant order becomes
-            --  irrelevant in that case.
-
-            if not Assoc_Present then
-               Next_Discriminant (Disc);
-            end if;
-
-            --  Iterate over associations
-
-            if not Is_List_Member (Assoc) then
-               exit;
-            else
-               Nlists.Next (Assoc);
-            end if;
-         end loop;
-      end Check_Return_Construct_Accessibility;
-
       -------------------------------------
       -- Check_Return_Subtype_Indication --
       -------------------------------------
@@ -1495,7 +982,7 @@ package body Sem_Ch6 is
             Resolve (Expr, R_Type);
             Check_Limited_Return (N, Expr, R_Type);
 
-            Check_Return_Construct_Accessibility (N);
+            Check_Return_Construct_Accessibility (N, Stm_Entity);
 
             --  Ada 2022 (AI12-0269): Any return statement that applies to a
             --  nonreturning function shall be a simple_return_statement with
@@ -1551,7 +1038,7 @@ package body Sem_Ch6 is
 
             Check_References (Stm_Entity);
 
-            Check_Return_Construct_Accessibility (N);
+            Check_Return_Construct_Accessibility (N, Stm_Entity);
 
             --  Check RM 6.5 (5.9/3)
 
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index e43e3ae0b41..aad86fab328 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Aspects;        use Aspects;
 with Atree;          use Atree;
 with Checks;         use Checks;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index e702df68a32..70c7c7cc9d5 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Aspects;        use Aspects;
 with Atree;          use Atree;
 with Checks;         use Checks;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index a13d9ebef5b..1fef8475c05 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Casing;         use Casing;
 with Checks;         use Checks;
 with Debug;          use Debug;
@@ -30,7 +31,6 @@ with Einfo.Utils;    use Einfo.Utils;
 with Elists;         use Elists;
 with Errout;         use Errout;
 with Erroutc;        use Erroutc;
-with Exp_Ch3;        use Exp_Ch3;
 with Exp_Ch6;        use Exp_Ch6;
 with Exp_Ch11;       use Exp_Ch11;
 with Exp_Util;       use Exp_Util;
@@ -255,740 +255,6 @@ package body Sem_Util is
       return Interface_List (Nod);
    end Abstract_Interface_List;
 
-   -------------------------
-   -- Accessibility_Level --
-   -------------------------
-
-   function Accessibility_Level
-     (Expr              : Node_Id;
-      Level             : Accessibility_Level_Kind;
-      In_Return_Context : Boolean := False;
-      Allow_Alt_Model   : Boolean := True) return Node_Id
-   is
-      Loc : constant Source_Ptr := Sloc (Expr);
-
-      function Accessibility_Level (Expr : Node_Id) return Node_Id
-        is (Accessibility_Level (Expr, Level, In_Return_Context));
-      --  Renaming of the enclosing function to facilitate recursive calls
-
-      function Make_Level_Literal (Level : Uint) return Node_Id;
-      --  Construct an integer literal representing an accessibility level
-      --  with its type set to Natural.
-
-      function Innermost_Master_Scope_Depth (N : Node_Id) return Uint;
-      --  Returns the scope depth of the given node's innermost enclosing
-      --  scope (effectively the accessibility level of the innermost
-      --  enclosing master).
-
-      function Function_Call_Or_Allocator_Level (N : Node_Id) return Node_Id;
-      --  Centralized processing of subprogram calls which may appear in
-      --  prefix notation.
-
-      function Typ_Access_Level (Typ : Entity_Id) return Uint
-        is (Type_Access_Level (Typ, Allow_Alt_Model));
-      --  Renaming of Type_Access_Level with Allow_Alt_Model specified to avoid
-      --  passing the parameter specifically in every call.
-
-      ----------------------------------
-      -- Innermost_Master_Scope_Depth --
-      ----------------------------------
-
-      function Innermost_Master_Scope_Depth (N : Node_Id) return Uint is
-         Encl_Scop           : Entity_Id;
-         Ent                 : Entity_Id;
-         Node_Par            : Node_Id := Parent (N);
-         Master_Lvl_Modifier : Int     := 0;
-
-      begin
-         --  Locate the nearest enclosing node (by traversing Parents)
-         --  that Defining_Entity can be applied to, and return the
-         --  depth of that entity's nearest enclosing scope.
-
-         --  The rules that define what a master are defined in
-         --  RM 7.6.1 (3), and include statements and conditions for loops
-         --  among other things. These cases are detected properly ???
-
-         while Present (Node_Par) loop
-            Ent := Defining_Entity_Or_Empty (Node_Par);
-
-            if Present (Ent) then
-               Encl_Scop := Find_Enclosing_Scope (Ent);
-
-               --  Ignore transient scopes made during expansion
-
-               if Comes_From_Source (Node_Par) 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);
-                  else
-                     return
-                       Scope_Depth (Encl_Scop) + Master_Lvl_Modifier;
-                  end if;
-               end if;
-
-            --  For a return statement within a function, return
-            --  the depth of the function itself. This is not just
-            --  a small optimization, but matters when analyzing
-            --  the expression in an expression function before
-            --  the body is created.
-
-            elsif Nkind (Node_Par) in N_Extended_Return_Statement
-                                    | N_Simple_Return_Statement
-            then
-               return Scope_Depth (Enclosing_Subprogram (Node_Par));
-
-            --  Statements are counted as masters
-
-            elsif Is_Master (Node_Par) then
-               Master_Lvl_Modifier := Master_Lvl_Modifier + 1;
-
-            end if;
-
-            Node_Par := Parent (Node_Par);
-         end loop;
-
-         --  Should never reach the following return
-
-         pragma Assert (False);
-
-         return Scope_Depth (Current_Scope) + 1;
-      end Innermost_Master_Scope_Depth;
-
-      ------------------------
-      -- Make_Level_Literal --
-      ------------------------
-
-      function Make_Level_Literal (Level : Uint) return Node_Id is
-         Result : constant Node_Id := Make_Integer_Literal (Loc, Level);
-
-      begin
-         Set_Etype (Result, Standard_Natural);
-         return Result;
-      end Make_Level_Literal;
-
-      --------------------------------------
-      -- Function_Call_Or_Allocator_Level --
-      --------------------------------------
-
-      function Function_Call_Or_Allocator_Level (N : Node_Id) return Node_Id is
-         Par      : Node_Id;
-         Prev_Par : Node_Id;
-      begin
-         --  Results of functions are objects, so we either get the
-         --  accessibility of the function or, in case of a call which is
-         --  indirect, the level of the access-to-subprogram type.
-
-         --  This code looks wrong ???
-
-         if Nkind (N) = N_Function_Call
-           and then Ada_Version < Ada_2005
-         then
-            if Is_Entity_Name (Name (N)) then
-               return Make_Level_Literal
-                        (Subprogram_Access_Level (Entity (Name (N))));
-            else
-               return Make_Level_Literal
-                        (Typ_Access_Level (Etype (Prefix (Name (N)))));
-            end if;
-
-         --  We ignore coextensions as they cannot be implemented under the
-         --  "small-integer" model.
-
-         elsif Nkind (N) = N_Allocator
-           and then (Is_Static_Coextension (N)
-                      or else Is_Dynamic_Coextension (N))
-         then
-            return Make_Level_Literal (Scope_Depth (Standard_Standard));
-         end if;
-
-         --  Named access types have a designated level
-
-         if Is_Named_Access_Type (Etype (N)) then
-            return Make_Level_Literal (Typ_Access_Level (Etype (N)));
-
-         --  Otherwise, the level is dictated by RM 3.10.2 (10.7/3)
-
-         else
-            --  Check No_Dynamic_Accessibility_Checks restriction override for
-            --  alternative accessibility model.
-
-            if Allow_Alt_Model
-              and then No_Dynamic_Accessibility_Checks_Enabled (N)
-              and then Is_Anonymous_Access_Type (Etype (N))
-            then
-               --  In the alternative model the level is that of the
-               --  designated type.
-
-               if Debug_Flag_Underscore_B then
-                  return Make_Level_Literal (Typ_Access_Level (Etype (N)));
-
-               --  For function calls the level is that of the innermost
-               --  master, otherwise (for allocators etc.) we get the level
-               --  of the corresponding anonymous access type, which is
-               --  calculated through the normal path of execution.
-
-               elsif Nkind (N) = N_Function_Call then
-                  return Make_Level_Literal
-                           (Innermost_Master_Scope_Depth (Expr));
-               end if;
-            end if;
-
-            if Nkind (N) = N_Function_Call then
-               --  Dynamic checks are generated when we are within a return
-               --  value or we are in a function call within an anonymous
-               --  access discriminant constraint of a return object (signified
-               --  by In_Return_Context) on the side of the callee.
-
-               --  So, in this case, return accessibility level of the
-               --  enclosing subprogram.
-
-               if In_Return_Value (N)
-                 or else In_Return_Context
-               then
-                  return Make_Level_Literal
-                           (Subprogram_Access_Level (Current_Subprogram));
-               end if;
-            end if;
-
-            --  When the call is being dereferenced the level is that of the
-            --  enclosing master of the dereferenced call.
-
-            if Nkind (Parent (N)) in N_Explicit_Dereference
-                                   | N_Indexed_Component
-                                   | N_Selected_Component
-            then
-               return Make_Level_Literal
-                        (Innermost_Master_Scope_Depth (Expr));
-            end if;
-
-            --  Find any relevant enclosing parent nodes that designate an
-            --  object being initialized.
-
-            --  Note: The above is only relevant if the result is used "in its
-            --  entirety" as RM 3.10.2 (10.2/3) states. However, this is
-            --  accounted for in the case statement in the main body of
-            --  Accessibility_Level for N_Selected_Component.
-
-            Par      := Parent (Expr);
-            Prev_Par := Empty;
-            while Present (Par) loop
-               --  Detect an expanded implicit conversion, typically this
-               --  occurs on implicitly converted actuals in calls.
-
-               --  Does this catch all implicit conversions ???
-
-               if Nkind (Par) = N_Type_Conversion
-                 and then Is_Named_Access_Type (Etype (Par))
-               then
-                  return Make_Level_Literal
-                           (Typ_Access_Level (Etype (Par)));
-               end if;
-
-               --  Jump out when we hit an object declaration or the right-hand
-               --  side of an assignment, or a construct such as an aggregate
-               --  subtype indication which would be the result is not used
-               --  "in its entirety."
-
-               exit when Nkind (Par) in N_Object_Declaration
-                           or else (Nkind (Par) = N_Assignment_Statement
-                                     and then Name (Par) /= Prev_Par);
-
-               Prev_Par := Par;
-               Par      := Parent (Par);
-            end loop;
-
-            --  Assignment statements are handled in a similar way in
-            --  accordance to the left-hand part. However, strictly speaking,
-            --  this is illegal according to the RM, but this change is needed
-            --  to pass an ACATS C-test and is useful in general ???
-
-            case Nkind (Par) is
-               when N_Object_Declaration =>
-                  return Make_Level_Literal
-                           (Scope_Depth
-                             (Scope (Defining_Identifier (Par))));
-
-               when N_Assignment_Statement =>
-                  --  Return the accessibility level of the left-hand part
-
-                  return Accessibility_Level
-                           (Expr              => Name (Par),
-                            Level             => Object_Decl_Level,
-                            In_Return_Context => In_Return_Context);
-
-               when others =>
-                  return Make_Level_Literal
-                           (Innermost_Master_Scope_Depth (Expr));
-            end case;
-         end if;
-      end Function_Call_Or_Allocator_Level;
-
-      --  Local variables
-
-      E   : Node_Id := Original_Node (Expr);
-      Pre : Node_Id;
-
-   --  Start of processing for Accessibility_Level
-
-   begin
-      --  We could be looking at a reference to a formal due to the expansion
-      --  of entries and other cases, so obtain the renaming if necessary.
-
-      if Present (Param_Entity (Expr)) then
-         E := Param_Entity (Expr);
-      end if;
-
-      --  Extract the entity
-
-      if Nkind (E) in N_Has_Entity and then Present (Entity (E)) then
-         E := Entity (E);
-
-         --  Deal with a possible renaming of a private protected component
-
-         if Ekind (E) in E_Constant | E_Variable and then Is_Prival (E) then
-            E := Prival_Link (E);
-         end if;
-      end if;
-
-      --  Perform the processing on the expression
-
-      case Nkind (E) is
-         --  The level of an aggregate is that of the innermost master that
-         --  evaluates it as defined in RM 3.10.2 (10/4).
-
-         when N_Aggregate =>
-            return Make_Level_Literal (Innermost_Master_Scope_Depth (Expr));
-
-         --  The accessibility level is that of the access type, except for an
-         --  anonymous allocators which have special rules defined in RM 3.10.2
-         --  (14/3).
-
-         when N_Allocator =>
-            return Function_Call_Or_Allocator_Level (E);
-
-         --  We could reach this point for two reasons. Either the expression
-         --  applies to a special attribute ('Loop_Entry, 'Result, or 'Old), or
-         --  we are looking at the access attributes directly ('Access,
-         --  'Address, or 'Unchecked_Access).
-
-         when N_Attribute_Reference =>
-            Pre := Original_Node (Prefix (E));
-
-            --  Regular 'Access attribute presence means we have to look at the
-            --  prefix.
-
-            if Attribute_Name (E) = Name_Access then
-               return Accessibility_Level (Prefix (E));
-
-            --  Unchecked or unrestricted attributes have unlimited depth
-
-            elsif Attribute_Name (E) in Name_Address
-                                      | Name_Unchecked_Access
-                                      | Name_Unrestricted_Access
-            then
-               return Make_Level_Literal (Scope_Depth (Standard_Standard));
-
-            --  'Access can be taken further against other special attributes,
-            --  so handle these cases explicitly.
-
-            elsif Attribute_Name (E)
-                    in Name_Old | Name_Loop_Entry | Name_Result
-            then
-               --  Named access types
-
-               if Is_Named_Access_Type (Etype (Pre)) then
-                  return Make_Level_Literal
-                           (Typ_Access_Level (Etype (Pre)));
-
-               --  Anonymous access types
-
-               elsif Nkind (Pre) in N_Has_Entity
-                 and then Ekind (Entity (Pre)) not in Subprogram_Kind
-                 and then Present (Get_Dynamic_Accessibility (Entity (Pre)))
-                 and then Level = Dynamic_Level
-               then
-                  return New_Occurrence_Of
-                           (Get_Dynamic_Accessibility (Entity (Pre)), Loc);
-
-               --  Otherwise the level is treated in a similar way as
-               --  aggregates according to RM 6.1.1 (35.1/4) which concerns
-               --  an implicit constant declaration - in turn defining the
-               --  accessibility level to be that of the implicit constant
-               --  declaration.
-
-               else
-                  return Make_Level_Literal
-                           (Innermost_Master_Scope_Depth (Expr));
-               end if;
-
-            else
-               raise Program_Error;
-            end if;
-
-         --  This is the "base case" for accessibility level calculations which
-         --  means we are near the end of our recursive traversal.
-
-         when N_Defining_Identifier =>
-            --  A dynamic check is performed on the side of the callee when we
-            --  are within a return statement, so return a library-level
-            --  accessibility level to null out checks on the side of the
-            --  caller.
-
-            if Is_Explicitly_Aliased (E)
-              and then (In_Return_Context
-                         or else (Level /= Dynamic_Level
-                                   and then In_Return_Value (Expr)))
-            then
-               return Make_Level_Literal (Scope_Depth (Standard_Standard));
-
-            --  Something went wrong and an extra accessibility formal has not
-            --  been generated when one should have ???
-
-            elsif Is_Formal (E)
-              and then No (Get_Dynamic_Accessibility (E))
-              and then Ekind (Etype (E)) = E_Anonymous_Access_Type
-            then
-               return Make_Level_Literal (Scope_Depth (Standard_Standard));
-
-            --  Stand-alone object of an anonymous access type "SAOAAT"
-
-            elsif (Is_Formal (E)
-                    or else Ekind (E) in E_Variable
-                                       | E_Constant)
-              and then Present (Get_Dynamic_Accessibility (E))
-              and then (Level = Dynamic_Level
-                         or else Level = Zero_On_Dynamic_Level)
-            then
-               if Level = Zero_On_Dynamic_Level then
-                  return Make_Level_Literal
-                           (Scope_Depth (Standard_Standard));
-               end if;
-
-               --  No_Dynamic_Accessibility_Checks restriction override for
-               --  alternative accessibility model.
-
-               if Allow_Alt_Model
-                 and then No_Dynamic_Accessibility_Checks_Enabled (E)
-               then
-                  --  In the alternative model the level is that of the
-                  --  designated type entity's context.
-
-                  if Debug_Flag_Underscore_B then
-                     return Make_Level_Literal (Typ_Access_Level (Etype (E)));
-
-                  --  Otherwise the level depends on the entity's context
-
-                  elsif Is_Formal (E) then
-                     return Make_Level_Literal
-                              (Subprogram_Access_Level
-                                (Enclosing_Subprogram (E)));
-                  else
-                     return Make_Level_Literal
-                              (Scope_Depth (Enclosing_Dynamic_Scope (E)));
-                  end if;
-               end if;
-
-               --  Return the dynamic level in the normal case
-
-               return New_Occurrence_Of
-                        (Get_Dynamic_Accessibility (E), Loc);
-
-            --  Initialization procedures have a special extra accessibility
-            --  parameter associated with the level at which the object
-            --  being initialized exists
-
-            elsif Ekind (E) = E_Record_Type
-              and then Is_Limited_Record (E)
-              and then Current_Scope = Init_Proc (E)
-              and then Present (Init_Proc_Level_Formal (Current_Scope))
-            then
-               return New_Occurrence_Of
-                        (Init_Proc_Level_Formal (Current_Scope), Loc);
-
-            --  Current instance of the type is deeper than that of the type
-            --  according to RM 3.10.2 (21).
-
-            elsif Is_Type (E) then
-               --  When restriction No_Dynamic_Accessibility_Checks is active
-               --  along with -gnatd_b.
-
-               if Allow_Alt_Model
-                 and then No_Dynamic_Accessibility_Checks_Enabled (E)
-                 and then Debug_Flag_Underscore_B
-               then
-                  return Make_Level_Literal (Typ_Access_Level (E));
-               end if;
-
-               --  Normal path
-
-               return Make_Level_Literal (Typ_Access_Level (E) + 1);
-
-            --  Move up the renamed entity or object if it came from source
-            --  since expansion may have created a dummy renaming under
-            --  certain circumstances.
-
-            --  Note: We check if the original node of the renaming comes
-            --  from source because the node may have been rewritten.
-
-            elsif Present (Renamed_Entity_Or_Object (E))
-              and then Comes_From_Source
-                (Original_Node (Renamed_Entity_Or_Object (E)))
-            then
-               return Accessibility_Level (Renamed_Entity_Or_Object (E));
-
-            --  Named access types get their level from their associated type
-
-            elsif Is_Named_Access_Type (Etype (E)) then
-               return Make_Level_Literal
-                        (Typ_Access_Level (Etype (E)));
-
-            --  Check if E is an expansion-generated renaming of an iterator
-            --  by examining Related_Expression. If so, determine the
-            --  accessibility level based on the original expression.
-
-            elsif Ekind (E) in E_Constant | E_Variable
-              and then Present (Related_Expression (E))
-            then
-               return Accessibility_Level (Related_Expression (E));
-
-            elsif Level = Dynamic_Level
-               and then Ekind (E) in E_In_Parameter | E_In_Out_Parameter
-               and then Present (Init_Proc_Level_Formal (Scope (E)))
-            then
-               return New_Occurrence_Of
-                        (Init_Proc_Level_Formal (Scope (E)), Loc);
-
-            --  Normal object - get the level of the enclosing scope
-
-            else
-               return Make_Level_Literal
-                        (Scope_Depth (Enclosing_Dynamic_Scope (E)));
-            end if;
-
-         --  Handle indexed and selected components including the special cases
-         --  whereby there is an implicit dereference, a component of a
-         --  composite type, or a function call in prefix notation.
-
-         --  We don't handle function calls in prefix notation correctly ???
-
-         when N_Indexed_Component | N_Selected_Component | N_Slice =>
-            Pre := Prefix (E);
-
-            --  Fetch the original node when the prefix comes from the result
-            --  of expanding a function call since we want to find the level
-            --  of the original source call.
-
-            if not Comes_From_Source (Pre)
-              and then Nkind (Original_Node (Pre)) = N_Function_Call
-            then
-               Pre := Original_Node (Pre);
-            end if;
-
-            --  When E is an indexed component or selected component and
-            --  the current Expr is a function call, we know that we are
-            --  looking at an expanded call in prefix notation.
-
-            if Nkind (Expr) = N_Function_Call then
-               return Function_Call_Or_Allocator_Level (Expr);
-
-            --  If the prefix is a named access type, then we are dealing
-            --  with an implicit deferences. In that case the level is that
-            --  of the named access type in the prefix.
-
-            elsif Is_Named_Access_Type (Etype (Pre)) then
-               return Make_Level_Literal
-                        (Typ_Access_Level (Etype (Pre)));
-
-            --  The current expression is a named access type, so there is no
-            --  reason to look at the prefix. Instead obtain the level of E's
-            --  named access type.
-
-            elsif Is_Named_Access_Type (Etype (E)) then
-               return Make_Level_Literal
-                        (Typ_Access_Level (Etype (E)));
-
-            --  A nondiscriminant selected component where the component
-            --  is an anonymous access type means that its associated
-            --  level is that of the containing type - see RM 3.10.2 (16).
-
-            --  Note that when restriction No_Dynamic_Accessibility_Checks is
-            --  in effect we treat discriminant components as regular
-            --  components.
-
-            elsif
-              (Nkind (E) = N_Selected_Component
-                and then Ekind (Etype (E))   =  E_Anonymous_Access_Type
-                and then Ekind (Etype (Pre)) /= E_Anonymous_Access_Type
-                and then (not (Nkind (Selector_Name (E)) in N_Has_Entity
-                                and then Ekind (Entity (Selector_Name (E)))
-                                           = E_Discriminant)
-
-                           --  The alternative accessibility models both treat
-                           --  discriminants as regular components.
-
-                           or else (No_Dynamic_Accessibility_Checks_Enabled (E)
-                                     and then Allow_Alt_Model)))
-
-              --  Arrays featuring components of anonymous access components
-              --  get their corresponding level from their containing type's
-              --  declaration.
-
-              or else
-                (Nkind (E) = N_Indexed_Component
-                  and then Ekind (Etype (E)) = E_Anonymous_Access_Type
-                  and then Ekind (Etype (Pre)) in Array_Kind
-                  and then Ekind (Component_Type (Base_Type (Etype (Pre))))
-                             = E_Anonymous_Access_Type)
-            then
-               --  When restriction No_Dynamic_Accessibility_Checks is active
-               --  and -gnatd_b set, the level is that of the designated type.
-
-               if Allow_Alt_Model
-                 and then No_Dynamic_Accessibility_Checks_Enabled (E)
-                 and then Debug_Flag_Underscore_B
-               then
-                  return Make_Level_Literal
-                           (Typ_Access_Level (Etype (E)));
-               end if;
-
-               --  Otherwise proceed normally
-
-               return Make_Level_Literal
-                        (Typ_Access_Level (Etype (Prefix (E))));
-
-            --  The accessibility calculation routine that handles function
-            --  calls (Function_Call_Level) assumes, in the case the
-            --  result is of an anonymous access type, that the result will be
-            --  used "in its entirety" when the call is present within an
-            --  assignment or object declaration.
-
-            --  To properly handle cases where the result is not used in its
-            --  entirety, we test if the prefix of the component in question is
-            --  a function call, which tells us that one of its components has
-            --  been identified and is being accessed. Therefore we can
-            --  conclude that the result is not used "in its entirety"
-            --  according to RM 3.10.2 (10.2/3).
-
-            elsif Nkind (Pre) = N_Function_Call
-              and then not Is_Named_Access_Type (Etype (Pre))
-            then
-               --  Dynamic checks are generated when we are within a return
-               --  value or we are in a function call within an anonymous
-               --  access discriminant constraint of a return object (signified
-               --  by In_Return_Context) on the side of the callee.
-
-               --  So, in this case, return a library accessibility level to
-               --  null out the check on the side of the caller.
-
-               if (In_Return_Value (E)
-                    or else In_Return_Context)
-                 and then Level /= Dynamic_Level
-               then
-                  return Make_Level_Literal
-                           (Scope_Depth (Standard_Standard));
-               end if;
-
-               return Make_Level_Literal
-                        (Innermost_Master_Scope_Depth (Expr));
-
-            --  Otherwise, continue recursing over the expression prefixes
-
-            else
-               return Accessibility_Level (Prefix (E));
-            end if;
-
-         --  Qualified expressions
-
-         when N_Qualified_Expression =>
-            if Is_Named_Access_Type (Etype (E)) then
-               return Make_Level_Literal
-                        (Typ_Access_Level (Etype (E)));
-            else
-               return Accessibility_Level (Expression (E));
-            end if;
-
-         --  Handle function calls
-
-         when N_Function_Call =>
-            return Function_Call_Or_Allocator_Level (E);
-
-         --  Explicit dereference accessibility level calculation
-
-         when N_Explicit_Dereference =>
-            Pre := Original_Node (Prefix (E));
-
-            --  The prefix is a named access type so the level is taken from
-            --  its type.
-
-            if Is_Named_Access_Type (Etype (Pre)) then
-               return Make_Level_Literal (Typ_Access_Level (Etype (Pre)));
-
-            --  Otherwise, recurse deeper
-
-            else
-               return Accessibility_Level (Prefix (E));
-            end if;
-
-         --  Type conversions
-
-         when N_Type_Conversion | N_Unchecked_Type_Conversion =>
-            --  View conversions are special in that they require use to
-            --  inspect the expression of the type conversion.
-
-            --  Allocators of anonymous access types are internally generated,
-            --  so recurse deeper in that case as well.
-
-            if Is_View_Conversion (E)
-              or else Ekind (Etype (E)) = E_Anonymous_Access_Type
-            then
-               return Accessibility_Level (Expression (E));
-
-            --  We don't care about the master if we are looking at a named
-            --  access type.
-
-            elsif Is_Named_Access_Type (Etype (E)) then
-               return Make_Level_Literal
-                        (Typ_Access_Level (Etype (E)));
-
-            --  In section RM 3.10.2 (10/4) the accessibility rules for
-            --  aggregates and value conversions are outlined. Are these
-            --  followed in the case of initialization of an object ???
-
-            --  Should use Innermost_Master_Scope_Depth ???
-
-            else
-               return Accessibility_Level (Current_Scope);
-            end if;
-
-         --  Default to the type accessibility level for the type of the
-         --  expression's entity.
-
-         when others =>
-            return Make_Level_Literal (Typ_Access_Level (Etype (E)));
-      end case;
-   end Accessibility_Level;
-
-   --------------------------------
-   -- Static_Accessibility_Level --
-   --------------------------------
-
-   function Static_Accessibility_Level
-     (Expr              : Node_Id;
-      Level             : Static_Accessibility_Level_Kind;
-      In_Return_Context : Boolean := False) return Uint
-   is
-   begin
-      return Intval
-               (Accessibility_Level (Expr, Level, In_Return_Context));
-   end Static_Accessibility_Level;
-
    ----------------------------------
    -- Acquire_Warning_Match_String --
    ----------------------------------
@@ -7420,57 +6686,16 @@ package body Sem_Util is
       else
          return Enclosing_Subprogram (Scop);
       end if;
-   end Current_Subprogram;
-
-   ------------------------------
-   -- CW_Or_Needs_Finalization --
-   ------------------------------
-
-   function CW_Or_Needs_Finalization (Typ : Entity_Id) return Boolean is
-   begin
-      return Is_Class_Wide_Type (Typ) or else Needs_Finalization (Typ);
-   end CW_Or_Needs_Finalization;
-
-   -------------------------------
-   -- Deepest_Type_Access_Level --
-   -------------------------------
-
-   function Deepest_Type_Access_Level
-     (Typ             : Entity_Id;
-      Allow_Alt_Model : Boolean := True) return Uint
-   is
-   begin
-      if Ekind (Typ) = E_Anonymous_Access_Type
-        and then not Is_Local_Anonymous_Access (Typ)
-        and then Nkind (Associated_Node_For_Itype (Typ)) = N_Object_Declaration
-      then
-         --  No_Dynamic_Accessibility_Checks override for alternative
-         --  accessibility model.
-
-         if Allow_Alt_Model
-           and then No_Dynamic_Accessibility_Checks_Enabled (Typ)
-         then
-            return Type_Access_Level (Typ, Allow_Alt_Model);
-         end if;
-
-         --  Typ is the type of an Ada 2012 stand-alone object of an anonymous
-         --  access type.
-
-         return
-           Scope_Depth (Enclosing_Dynamic_Scope
-                         (Defining_Identifier
-                           (Associated_Node_For_Itype (Typ))));
-
-      --  For generic formal type, return Int'Last (infinite).
-      --  See comment preceding Is_Generic_Type call in Type_Access_Level.
+   end Current_Subprogram;
 
-      elsif Is_Generic_Type (Root_Type (Typ)) then
-         return UI_From_Int (Int'Last);
+   ------------------------------
+   -- CW_Or_Needs_Finalization --
+   ------------------------------
 
-      else
-         return Type_Access_Level (Typ, Allow_Alt_Model);
-      end if;
-   end Deepest_Type_Access_Level;
+   function CW_Or_Needs_Finalization (Typ : Entity_Id) return Boolean is
+   begin
+      return Is_Class_Wide_Type (Typ) or else Needs_Finalization (Typ);
+   end CW_Or_Needs_Finalization;
 
    ---------------------
    -- Defining_Entity --
@@ -8182,21 +7407,6 @@ package body Sem_Util is
       return False;
    end Discriminated_Size;
 
-   -----------------------------------
-   -- Effective_Extra_Accessibility --
-   -----------------------------------
-
-   function Effective_Extra_Accessibility (Id : Entity_Id) return Entity_Id is
-   begin
-      if Present (Renamed_Object (Id))
-        and then Is_Entity_Name (Renamed_Object (Id))
-      then
-         return Effective_Extra_Accessibility (Entity (Renamed_Object (Id)));
-      else
-         return Extra_Accessibility (Id);
-      end if;
-   end Effective_Extra_Accessibility;
-
    -----------------------------
    -- Effective_Reads_Enabled --
    -----------------------------
@@ -10776,30 +9986,6 @@ package body Sem_Util is
       end if;
    end Gather_Components;
 
-   -------------------------------
-   -- Get_Dynamic_Accessibility --
-   -------------------------------
-
-   function Get_Dynamic_Accessibility (E : Entity_Id) return Entity_Id is
-   begin
-      --  When minimum accessibility is set for E then we utilize it - except
-      --  in a few edge cases like the expansion of select statements where
-      --  generated subprogram may attempt to unnecessarily use a minimum
-      --  accessibility object declared outside of scope.
-
-      --  To avoid these situations where expansion may get complex we verify
-      --  that the minimum accessibility object is within scope.
-
-      if Is_Formal (E)
-        and then Present (Minimum_Accessibility (E))
-        and then In_Open_Scopes (Scope (Minimum_Accessibility (E)))
-      then
-         return Minimum_Accessibility (E);
-      end if;
-
-      return Extra_Accessibility (E);
-   end Get_Dynamic_Accessibility;
-
    ------------------------
    -- Get_Actual_Subtype --
    ------------------------
@@ -12006,85 +11192,6 @@ package body Sem_Util is
       end if;
    end Get_Views;
 
-   -----------------------
-   -- Has_Access_Values --
-   -----------------------
-
-   function Has_Access_Values (T : Entity_Id) return Boolean
-   is
-      Typ : constant Entity_Id := Underlying_Type (T);
-
-   begin
-      --  Case of a private type which is not completed yet. This can only
-      --  happen in the case of a generic formal type appearing directly, or
-      --  as a component of the type to which this function is being applied
-      --  at the top level. Return False in this case, since we certainly do
-      --  not know that the type contains access types.
-
-      if No (Typ) then
-         return False;
-
-      elsif Is_Access_Type (Typ) then
-         return True;
-
-      elsif Is_Array_Type (Typ) then
-         return Has_Access_Values (Component_Type (Typ));
-
-      elsif Is_Record_Type (Typ) then
-         declare
-            Comp : Entity_Id;
-
-         begin
-            --  Loop to check components
-
-            Comp := First_Component_Or_Discriminant (Typ);
-            while Present (Comp) loop
-
-               --  Check for access component, tag field does not count, even
-               --  though it is implemented internally using an access type.
-
-               if Has_Access_Values (Etype (Comp))
-                 and then Chars (Comp) /= Name_uTag
-               then
-                  return True;
-               end if;
-
-               Next_Component_Or_Discriminant (Comp);
-            end loop;
-         end;
-
-         return False;
-
-      else
-         return False;
-      end if;
-   end Has_Access_Values;
-
-   ---------------------------------------
-   -- Has_Anonymous_Access_Discriminant --
-   ---------------------------------------
-
-   function Has_Anonymous_Access_Discriminant (Typ : Entity_Id) return Boolean
-   is
-      Disc : Node_Id;
-
-   begin
-      if not Has_Discriminants (Typ) then
-         return False;
-      end if;
-
-      Disc := First_Discriminant (Typ);
-      while Present (Disc) loop
-         if Ekind (Etype (Disc)) = E_Anonymous_Access_Type then
-            return True;
-         end if;
-
-         Next_Discriminant (Disc);
-      end loop;
-
-      return False;
-   end Has_Anonymous_Access_Discriminant;
-
    ------------------------------
    -- Has_Compatible_Alignment --
    ------------------------------
@@ -14382,32 +13489,6 @@ package body Sem_Util is
       end if;
    end Has_Tagged_Component;
 
-   --------------------------------------------
-   -- Has_Unconstrained_Access_Discriminants --
-   --------------------------------------------
-
-   function Has_Unconstrained_Access_Discriminants
-     (Subtyp : Entity_Id) return Boolean
-   is
-      Discr : Entity_Id;
-
-   begin
-      if Has_Discriminants (Subtyp)
-        and then not Is_Constrained (Subtyp)
-      then
-         Discr := First_Discriminant (Subtyp);
-         while Present (Discr) loop
-            if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then
-               return True;
-            end if;
-
-            Next_Discriminant (Discr);
-         end loop;
-      end if;
-
-      return False;
-   end Has_Unconstrained_Access_Discriminants;
-
    -----------------------------
    -- Has_Undefined_Reference --
    -----------------------------
@@ -15989,28 +15070,6 @@ package body Sem_Util is
       end if;
    end Invalid_Scalar_Value;
 
-   --------------------------------
-   -- Is_Anonymous_Access_Actual --
-   --------------------------------
-
-   function Is_Anonymous_Access_Actual (N : Node_Id) return Boolean is
-      Par : Node_Id;
-   begin
-      if Ekind (Etype (N)) /= E_Anonymous_Access_Type then
-         return False;
-      end if;
-
-      Par := Parent (N);
-      while Present (Par)
-        and then Nkind (Par) in N_Case_Expression
-                              | N_If_Expression
-                              | N_Parameter_Association
-      loop
-         Par := Parent (Par);
-      end loop;
-      return Nkind (Par) in N_Subprogram_Call;
-   end Is_Anonymous_Access_Actual;
-
    ------------------------
    -- Is_Access_Variable --
    ------------------------
@@ -21224,38 +20283,6 @@ package body Sem_Util is
           and then Is_Single_Concurrent_Type (Etype (Id));
    end Is_Single_Task_Object;
 
-   --------------------------------------
-   -- Is_Special_Aliased_Formal_Access --
-   --------------------------------------
-
-   function Is_Special_Aliased_Formal_Access
-     (Exp               : Node_Id;
-      In_Return_Context : Boolean := False) return Boolean
-   is
-      Scop : constant Entity_Id := Current_Subprogram;
-   begin
-      --  Verify the expression is an access reference to 'Access within a
-      --  return statement as this is the only time an explicitly aliased
-      --  formal has different semantics.
-
-      if Nkind (Exp) /= N_Attribute_Reference
-        or else Get_Attribute_Id (Attribute_Name (Exp)) /= Attribute_Access
-        or else not (In_Return_Value (Exp)
-                      or else In_Return_Context)
-        or else not Needs_Result_Accessibility_Level (Scop)
-      then
-         return False;
-      end if;
-
-      --  Check if the prefix of the reference is indeed an explicitly aliased
-      --  formal parameter for the function Scop. Additionally, we must check
-      --  that Scop returns an anonymous access type, otherwise the special
-      --  rules dictating a need for a dynamic check are not in effect.
-
-      return Is_Entity_Name (Prefix (Exp))
-               and then Is_Explicitly_Aliased (Entity (Prefix (Exp)));
-   end Is_Special_Aliased_Formal_Access;
-
    -----------------------------
    -- Is_Specific_Tagged_Type --
    -----------------------------
@@ -23228,144 +22255,6 @@ package body Sem_Util is
       end if;
    end Needs_One_Actual;
 
-   --------------------------------------
-   -- Needs_Result_Accessibility_Level --
-   --------------------------------------
-
-   function Needs_Result_Accessibility_Level
-     (Func_Id : Entity_Id) return Boolean
-   is
-      Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
-
-      function Has_Unconstrained_Access_Discriminant_Component
-        (Comp_Typ : Entity_Id) return Boolean;
-      --  Returns True if any component of the type has an unconstrained access
-      --  discriminant.
-
-      -----------------------------------------------------
-      -- Has_Unconstrained_Access_Discriminant_Component --
-      -----------------------------------------------------
-
-      function Has_Unconstrained_Access_Discriminant_Component
-        (Comp_Typ :  Entity_Id) return Boolean
-      is
-      begin
-         if not Is_Limited_Type (Comp_Typ) then
-            return False;
-
-         --  Only limited types can have access discriminants with
-         --  defaults.
-
-         elsif Has_Unconstrained_Access_Discriminants (Comp_Typ) then
-            return True;
-
-         elsif Is_Array_Type (Comp_Typ) then
-            return Has_Unconstrained_Access_Discriminant_Component
-                     (Underlying_Type (Component_Type (Comp_Typ)));
-
-         elsif Is_Record_Type (Comp_Typ) then
-            declare
-               Comp : Entity_Id;
-
-            begin
-               Comp := First_Component (Comp_Typ);
-               while Present (Comp) loop
-                  if Has_Unconstrained_Access_Discriminant_Component
-                       (Underlying_Type (Etype (Comp)))
-                  then
-                     return True;
-                  end if;
-
-                  Next_Component (Comp);
-               end loop;
-            end;
-         end if;
-
-         return False;
-      end Has_Unconstrained_Access_Discriminant_Component;
-
-      Disable_Tagged_Cases : constant Boolean := True;
-      --  Flag used to temporarily disable a "True" result for tagged types.
-      --  See comments further below for details.
-
-   --  Start of processing for Needs_Result_Accessibility_Level
-
-   begin
-      --  False if completion unavailable, which can happen when we are
-      --  analyzing an abstract subprogram or if the subprogram has
-      --  delayed freezing.
-
-      if No (Func_Typ) then
-         return False;
-
-      --  False if not a function, also handle enum-lit renames case
-
-      elsif Func_Typ = Standard_Void_Type
-        or else Is_Scalar_Type (Func_Typ)
-      then
-         return False;
-
-      --  Handle a corner case, a cross-dialect subp renaming. For example,
-      --  an Ada 2012 renaming of an Ada 2005 subprogram. This can occur when
-      --  an Ada 2005 (or earlier) unit references predefined run-time units.
-
-      elsif Present (Alias (Func_Id)) then
-
-         --  Unimplemented: a cross-dialect subp renaming which does not set
-         --  the Alias attribute (e.g., a rename of a dereference of an access
-         --  to subprogram value). ???
-
-         return Present (Extra_Accessibility_Of_Result (Alias (Func_Id)));
-
-      --  Remaining cases require Ada 2012 mode, unless they are dispatching
-      --  operations, since they may be overridden by Ada_2012 primitives.
-
-      elsif Ada_Version < Ada_2012
-        and then not Is_Dispatching_Operation (Func_Id)
-      then
-         return False;
-
-      --  Handle the situation where a result is an anonymous access type
-      --  RM 3.10.2 (10.3/3).
-
-      elsif Ekind (Func_Typ) = E_Anonymous_Access_Type then
-         return True;
-
-      --  In the case of, say, a null tagged record result type, the need for
-      --  this extra parameter might not be obvious so this function returns
-      --  True for all tagged types for compatibility reasons.
-
-      --  A function with, say, a tagged null controlling result type might
-      --  be overridden by a primitive of an extension having an access
-      --  discriminant and the overrider and overridden must have compatible
-      --  calling conventions (including implicitly declared parameters).
-
-      --  Similarly, values of one access-to-subprogram type might designate
-      --  both a primitive subprogram of a given type and a function which is,
-      --  for example, not a primitive subprogram of any type. Again, this
-      --  requires calling convention compatibility. It might be possible to
-      --  solve these issues by introducing wrappers, but that is not the
-      --  approach that was chosen.
-
-      --  Note: Despite the reasoning noted above, the extra accessibility
-      --  parameter for tagged types is disabled for performance reasons.
-
-      elsif Is_Tagged_Type (Func_Typ) then
-         return not Disable_Tagged_Cases;
-
-      elsif Has_Unconstrained_Access_Discriminants (Func_Typ) then
-         return True;
-
-      elsif Has_Unconstrained_Access_Discriminant_Component (Func_Typ) then
-         return True;
-
-      --  False for all other cases
-
-      else
-         return False;
-      end if;
-   end Needs_Result_Accessibility_Level;
-
    ----------------------------
    --  Needs_Secondary_Stack --
    ----------------------------
@@ -29179,19 +28068,6 @@ package body Sem_Util is
           and then Has_Loop_Entry_Attributes (Entity (Identifier (Stmt)));
    end Subject_To_Loop_Entry_Attributes;
 
-   -----------------------------
-   -- Subprogram_Access_Level --
-   -----------------------------
-
-   function Subprogram_Access_Level (Subp : Entity_Id) return Uint is
-   begin
-      if Present (Alias (Subp)) then
-         return Subprogram_Access_Level (Alias (Subp));
-      else
-         return Scope_Depth (Enclosing_Dynamic_Scope (Subp));
-      end if;
-   end Subprogram_Access_Level;
-
    ---------------------
    -- Subprogram_Name --
    ---------------------
@@ -29651,179 +28527,6 @@ package body Sem_Util is
       Discard := Traverse (Node);
    end Traverse_More_Proc;
 
-   -----------------------
-   -- Type_Access_Level --
-   -----------------------
-
-   function Type_Access_Level
-     (Typ             : Entity_Id;
-      Allow_Alt_Model : Boolean   := True;
-      Assoc_Ent       : Entity_Id := Empty) return Uint
-   is
-      Btyp    : Entity_Id := Base_Type (Typ);
-      Def_Ent : Entity_Id;
-
-   begin
-      --  Ada 2005 (AI-230): For most cases of anonymous access types, we
-      --  simply use the level where the type is declared. This is true for
-      --  stand-alone object declarations, and for anonymous access types
-      --  associated with components the level is the same as that of the
-      --  enclosing composite type. However, special treatment is needed for
-      --  the cases of access parameters, return objects of an anonymous access
-      --  type, and, in Ada 95, access discriminants of limited types.
-
-      if Is_Access_Type (Btyp) then
-         if Ekind (Btyp) = E_Anonymous_Access_Type then
-            --  No_Dynamic_Accessibility_Checks restriction override for
-            --  alternative accessibility model.
-
-            if Allow_Alt_Model
-              and then No_Dynamic_Accessibility_Checks_Enabled (Btyp)
-            then
-               --  In the -gnatd_b model, the level of an anonymous access
-               --  type is always that of the designated type.
-
-               if Debug_Flag_Underscore_B then
-                  return Type_Access_Level
-                           (Designated_Type (Btyp), Allow_Alt_Model);
-               end if;
-
-               --  When an anonymous access type's Assoc_Ent is specified,
-               --  calculate the result based on the general accessibility
-               --  level routine.
-
-               --  We would like to use Associated_Node_For_Itype here instead,
-               --  but in some cases it is not fine grained enough ???
-
-               if Present (Assoc_Ent) then
-                  return Static_Accessibility_Level
-                           (Assoc_Ent, Object_Decl_Level);
-               end if;
-
-               --  Otherwise take the context of the anonymous access type into
-               --  account.
-
-               --  Obtain the defining entity for the internally generated
-               --  anonymous access type.
-
-               Def_Ent := Defining_Entity_Or_Empty
-                            (Associated_Node_For_Itype (Typ));
-
-               if Present (Def_Ent) then
-                  --  When the defining entity is a subprogram then we know the
-                  --  anonymous access type Typ has been generated to either
-                  --  describe an anonymous access type formal or an anonymous
-                  --  access result type.
-
-                  --  Since we are only interested in the formal case, avoid
-                  --  the anonymous access result type.
-
-                  if Is_Subprogram (Def_Ent)
-                    and then not (Ekind (Def_Ent) = E_Function
-                                   and then Etype (Def_Ent) = Typ)
-                  then
-                     --  When the type comes from an anonymous access
-                     --  parameter, the level is that of the subprogram
-                     --  declaration.
-
-                     return Scope_Depth (Def_Ent);
-
-                  --  When the type is an access discriminant, the level is
-                  --  that of the type.
-
-                  elsif Ekind (Def_Ent) = E_Discriminant then
-                     return Scope_Depth (Scope (Def_Ent));
-                  end if;
-               end if;
-
-            --  If the type is a nonlocal anonymous access type (such as for
-            --  an access parameter) we treat it as being declared at the
-            --  library level to ensure that names such as X.all'access don't
-            --  fail static accessibility checks.
-
-            elsif not Is_Local_Anonymous_Access (Typ) then
-               return Scope_Depth (Standard_Standard);
-
-            --  If this is a return object, the accessibility level is that of
-            --  the result subtype of the enclosing function. The test here is
-            --  little complicated, because we have to account for extended
-            --  return statements that have been rewritten as blocks, in which
-            --  case we have to find and the Is_Return_Object attribute of the
-            --  itype's associated object. It would be nice to find a way to
-            --  simplify this test, but it doesn't seem worthwhile to add a new
-            --  flag just for purposes of this test. ???
-
-            elsif Ekind (Scope (Btyp)) = E_Return_Statement
-              or else
-                (Is_Itype (Btyp)
-                  and then Nkind (Associated_Node_For_Itype (Btyp)) =
-                                                         N_Object_Declaration
-                  and then Is_Return_Object
-                             (Defining_Identifier
-                                (Associated_Node_For_Itype (Btyp))))
-            then
-               declare
-                  Scop : Entity_Id;
-
-               begin
-                  Scop := Scope (Scope (Btyp));
-                  while Present (Scop) loop
-                     exit when Ekind (Scop) = E_Function;
-                     Scop := Scope (Scop);
-                  end loop;
-
-                  --  Treat the return object's type as having the level of the
-                  --  function's result subtype (as per RM05-6.5(5.3/2)).
-
-                  return Type_Access_Level (Etype (Scop), Allow_Alt_Model);
-               end;
-            end if;
-         end if;
-
-         Btyp := Root_Type (Btyp);
-
-         --  The accessibility level of anonymous access types associated with
-         --  discriminants is that of the current instance of the type, and
-         --  that's deeper than the type itself (AARM 3.10.2 (12.3.21)).
-
-         --  AI-402: access discriminants have accessibility based on the
-         --  object rather than the type in Ada 2005, so the above paragraph
-         --  doesn't apply.
-
-         --  ??? Needs completion with rules from AI-416
-
-         if Ada_Version <= Ada_95
-           and then Ekind (Typ) = E_Anonymous_Access_Type
-           and then Present (Associated_Node_For_Itype (Typ))
-           and then Nkind (Associated_Node_For_Itype (Typ)) =
-                                                 N_Discriminant_Specification
-         then
-            return Scope_Depth (Enclosing_Dynamic_Scope (Btyp)) + 1;
-         end if;
-      end if;
-
-      --  Return library level for a generic formal type. This is done because
-      --  RM(10.3.2) says that "The statically deeper relationship does not
-      --  apply to ... a descendant of a generic formal type". Rather than
-      --  checking at each point where a static accessibility check is
-      --  performed to see if we are dealing with a formal type, this rule is
-      --  implemented by having Type_Access_Level and Deepest_Type_Access_Level
-      --  return extreme values for a formal type; Deepest_Type_Access_Level
-      --  returns Int'Last. By calling the appropriate function from among the
-      --  two, we ensure that the static accessibility check will pass if we
-      --  happen to run into a formal type. More specifically, we should call
-      --  Deepest_Type_Access_Level instead of Type_Access_Level whenever the
-      --  call occurs as part of a static accessibility check and the error
-      --  case is the case where the type's level is too shallow (as opposed
-      --  to too deep).
-
-      if Is_Generic_Type (Root_Type (Btyp)) then
-         return Scope_Depth (Standard_Standard);
-      end if;
-
-      return Scope_Depth (Enclosing_Dynamic_Scope (Btyp));
-   end Type_Access_Level;
-
    ------------------------------------
    -- Type_Without_Stream_Operation  --
    ------------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index e651b205be2..34aaa9a932f 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -44,40 +44,6 @@ package Sem_Util is
    --  including the cases where there can't be any because e.g. the type is
    --  not tagged.
 
-   type Accessibility_Level_Kind is
-     (Dynamic_Level,
-      Object_Decl_Level,
-      Zero_On_Dynamic_Level);
-   --  Accessibility_Level_Kind is an enumerated type which captures the
-   --  different modes in which an accessibility level could be obtained for
-   --  a given expression.
-
-   --  When in the context of the function Accessibility_Level,
-   --  Accessibility_Level_Kind signals what type of accessibility level to
-   --  obtain. For example, when Level is Dynamic_Level, a defining identifier
-   --  associated with a SAOOAAT may be returned or an N_Integer_Literal node.
-   --  When the level is Object_Decl_Level, an N_Integer_Literal node is
-   --  returned containing the level of the declaration of the object if
-   --  relevant (be it a SAOOAAT or otherwise). Finally, Zero_On_Dynamic_Level
-   --  returns library level for all cases where the accessibility level is
-   --  dynamic (used to bypass static accessibility checks in dynamic cases).
-
-   function Accessibility_Level
-     (Expr              : Node_Id;
-      Level             : Accessibility_Level_Kind;
-      In_Return_Context : Boolean := False;
-      Allow_Alt_Model   : Boolean := True) return Node_Id;
-   --  Centralized accessibility level calculation routine for finding the
-   --  accessibility level of a given expression Expr.
-
-   --  In_Return_Context forces the Accessibility_Level calculations to be
-   --  carried out "as if" Expr existed in a return value. This is useful for
-   --  calculating the accessibility levels for discriminant associations
-   --  and return aggregates.
-
-   --  The Allow_Alt_Model parameter allows the alternative level calculation
-   --  under the restriction No_Dynamic_Accessibility_Checks to be performed.
-
    function Acquire_Warning_Match_String (Str_Lit : Node_Id) return String;
    --  Used by pragma Warnings (Off, string), and Warn_As_Error (string) to get
    --  the given string argument, adding leading and trailing asterisks if they
@@ -696,22 +662,6 @@ package Sem_Util is
    --  as Needs_Finalization except with pragma Restrictions (No_Finalization),
    --  in which case we know that class-wide objects do not need finalization.
 
-   function Deepest_Type_Access_Level
-     (Typ             : Entity_Id;
-      Allow_Alt_Model : Boolean := True) return Uint;
-
-   --  Same as Type_Access_Level, except that if the type is the type of an Ada
-   --  2012 stand-alone object of an anonymous access type, then return the
-   --  static accessibility level of the object. In that case, the dynamic
-   --  accessibility level of the object may take on values in a range. The low
-   --  bound of that range is returned by Type_Access_Level; this function
-   --  yields the high bound of that range. Also differs from Type_Access_Level
-   --  in the case of a descendant of a generic formal type (returns Int'Last
-   --  instead of 0).
-
-   --  The Allow_Alt_Model parameter allows the alternative level calculation
-   --  under the restriction No_Dynamic_Accessibility_Checks to be performed.
-
    function Defining_Entity (N : Node_Id) return Entity_Id;
    --  Given a declaration N, returns the associated defining entity. If the
    --  declaration has a specification, the entity is obtained from the
@@ -786,10 +736,6 @@ package Sem_Util is
    --  private components of protected objects, but is generally useful when
    --  restriction No_Implicit_Heap_Allocation is active.
 
-   function Effective_Extra_Accessibility (Id : Entity_Id) return Entity_Id;
-   --  Same as Einfo.Extra_Accessibility except thtat object renames
-   --  are looked through.
-
    function Effective_Reads_Enabled (Id : Entity_Id) return Boolean;
    --  Id should be the entity of a state abstraction, an object, or a type.
    --  Returns True iff Id is subject to external property Effective_Reads.
@@ -1146,10 +1092,6 @@ package Sem_Util is
    --  discriminants. Otherwise all components of the parent must be included
    --  in the subtype for semantic analysis.
 
-   function Get_Dynamic_Accessibility (E : Entity_Id) return Entity_Id;
-   --  Obtain the accessibility level for a given entity formal taking into
-   --  account both extra and minimum accessibility.
-
    function Get_Actual_Subtype (N : Node_Id) return Entity_Id;
    --  Given a node for an expression, obtain the actual subtype of the
    --  expression. In the case of a parameter where the formal is an
@@ -1393,18 +1335,6 @@ package Sem_Util is
    --  don't look inside packed array types. If Recurse is False, just
    --  go down one level (so it's no longer the "fullest" view).
 
-   function Has_Access_Values (T : Entity_Id) return Boolean;
-   --  Returns true if the underlying type of T is an access type, or has a
-   --  component (at any recursive level) that is an access type. This is a
-   --  conservative predicate, if it is not known whether or not T contains
-   --  access values (happens for generic formals in some cases), then False is
-   --  returned.  Note that tagged types return False. Even though the tag is
-   --  implemented as an access type internally, this function tests only for
-   --  access types known to the programmer. See also Has_Tagged_Component.
-
-   function Has_Anonymous_Access_Discriminant (Typ : Entity_Id) return Boolean;
-   --  Returns True if Typ has one or more anonymous access discriminants
-
    type Alignment_Result is (Known_Compatible, Unknown, Known_Incompatible);
    --  Result of Has_Compatible_Alignment test, description found below. Note
    --  that the values are arranged in increasing order of problematicness.
@@ -1544,20 +1474,6 @@ package Sem_Util is
    --  Return True if the loop has no side effect and can therefore be
    --  marked for removal. Return False if N is not a N_Loop_Statement.
 
-   subtype Static_Accessibility_Level_Kind
-     is Accessibility_Level_Kind range Object_Decl_Level
-                                         .. Zero_On_Dynamic_Level;
-   --  Restrict the reange of Accessibility_Level_Kind to be non-dynamic for
-   --  use in the static version of Accessibility_Level below.
-
-   function Static_Accessibility_Level
-     (Expr              : Node_Id;
-      Level             : Static_Accessibility_Level_Kind;
-      In_Return_Context : Boolean := False) return Uint;
-   --  Overloaded version of Accessibility_Level which returns a universal
-   --  integer for use in compile-time checking. Note: Level is restricted to
-   --  be non-dynamic.
-
    function Is_Newly_Constructed
      (Exp : Node_Id; Context_Requires_NC : Boolean) return Boolean;
    --  Indicates whether a given expression is "newly constructed" (RM 4.4).
@@ -1644,11 +1560,6 @@ package Sem_Util is
    --  a tagged type or has a subcomponent that is tagged. Returns False for a
    --  noncomposite type, or if no tagged subcomponents are present.
 
-   function Has_Unconstrained_Access_Discriminants
-     (Subtyp : Entity_Id) return Boolean;
-   --  Returns True if the given subtype is unconstrained and has one or more
-   --  access discriminants.
-
    function Has_Undefined_Reference (Expr : Node_Id) return Boolean;
    --  Given arbitrary expression Expr, determine whether it contains at
    --  least one name whose entity is Any_Id.
@@ -1822,10 +1733,6 @@ package Sem_Util is
    --  pragma Initialize_Scalars or by the binder. Return an expression created
    --  at source location Loc, which denotes the invalid value.
 
-   function Is_Anonymous_Access_Actual (N : Node_Id) return Boolean;
-   --  Determine if N is used as an actual for a call whose corresponding
-   --  formal is of an anonymous access type.
-
    function Is_Access_Subprogram_Wrapper (E : Entity_Id) return Boolean;
    --  True if E is the constructed wrapper for an access_to_subprogram
    --  type with Pre/Postconditions.
@@ -2400,21 +2307,6 @@ package Sem_Util is
    --  Determine whether arbitrary entity Id denotes the anonymous object
    --  created for a single task type.
 
-   function Is_Special_Aliased_Formal_Access
-     (Exp               : Node_Id;
-      In_Return_Context : Boolean := False) return Boolean;
-   --  Determines whether a dynamic check must be generated for explicitly
-   --  aliased formals within a function Scop for the expression Exp.
-
-   --  In_Return_Context forces Is_Special_Aliased_Formal_Access to assume
-   --  that Exp is within a return value which is useful for checking
-   --  expressions within discriminant associations of return objects.
-
-   --  More specially, Is_Special_Aliased_Formal_Access checks that Exp is a
-   --  'Access attribute reference within a return statement where the ultimate
-   --  prefix is an aliased formal of Scop and that Scop returns an anonymous
-   --  access type. See RM 3.10.2 for more details.
-
    function Is_Specific_Tagged_Type (Typ : Entity_Id) return Boolean;
    --  Determine whether an arbitrary [private] type is specifically tagged
 
@@ -2692,12 +2584,6 @@ package Sem_Util is
    --  syntactic ambiguity that results from an indexing of a function call
    --  that returns an array, so that Obj.F (X, Y) may mean F (Ob) (X, Y).
 
-   function Needs_Result_Accessibility_Level
-     (Func_Id : Entity_Id) return Boolean;
-   --  Ada 2012 (AI05-0234): Return True if the function needs an implicit
-   --  parameter to identify the accessibility level of the function result
-   --  "determined by the point of call".
-
    function Needs_Secondary_Stack (Id : Entity_Id) return Boolean;
    --  Return true if functions whose result type is Id must return on the
    --  secondary stack, i.e. allocate the return object on this stack.
@@ -3340,9 +3226,6 @@ package Sem_Util is
    --  Determine whether node N is a loop statement subject to at least one
    --  'Loop_Entry attribute.
 
-   function Subprogram_Access_Level (Subp : Entity_Id) return Uint;
-   --  Return the accessibility level of the view denoted by Subp
-
    function Support_Atomic_Primitives (Typ : Entity_Id) return Boolean;
    --  Return True if Typ supports the GCC built-in atomic operations (i.e. if
    --  Typ is properly sized and aligned).
@@ -3373,19 +3256,6 @@ package Sem_Util is
    --  returned, i.e. Traverse_More_Func is called and the result is simply
    --  discarded.
 
-   function Type_Access_Level
-     (Typ             : Entity_Id;
-      Allow_Alt_Model : Boolean   := True;
-      Assoc_Ent       : Entity_Id := Empty) return Uint;
-   --  Return the accessibility level of Typ
-
-   --  The Allow_Alt_Model parameter allows the alternative level calculation
-   --  under the restriction No_Dynamic_Accessibility_Checks to be performed.
-
-   --  Assoc_Ent allows for the optional specification of the entity associated
-   --  with Typ. This gets utilized mostly for anonymous access type
-   --  processing, where context matters in interpreting Typ's level.
-
    function Type_Without_Stream_Operation
      (T  : Entity_Id;
       Op : TSS_Name_Type := TSS_Null) return Entity_Id;
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index cbfabd2ceb3..1311916f19c 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Accessibility;  use Accessibility;
 with Atree;          use Atree;
 with Debug;          use Debug;
 with Einfo;          use Einfo;
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index c41b0f24742..7accb018a69 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -953,6 +953,11 @@ package Sinfo is
    --    Present in N_Simple_Return_Statement nodes. True if this node was
    --    constructed as part of the N_Extended_Return_Statement expansion.
 
+   --  Comes_From_Iterator
+   --    Present in N_Object_Renaming_Declaration nodes. True if this node was
+   --    was constructed as part of the expansion of an iterator
+   --    specification.
+
    --  Compile_Time_Known_Aggregate
    --    Present in N_Aggregate nodes. Set for aggregates which can be fully
    --    evaluated at compile time without raising constraint error. Such

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2022-12-06 14:00 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-12-06 14:00 [gcc r13-4508] ada: Accessibility code reorganization and bug fixes Marc Poulhi?s

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).