[Ada] Implementation of Preelaborable_Initialization attribute for AI12-0409

gcc/ada/

	* exp_attr.adb (Expand_N_Attribute_Reference): Fold
	Preelaborable_Initialization attribute in cases where it hasn't
	been folded by the analyzer.
	* exp_disp.adb (Original_View_In_Visible_Part): This function is
	removed and moved to sem_util.adb.
	* sem_attr.adb (Attribute_22): Add
	Attribute_Preelaborable_Initialization as an Ada 2022 attribute.
	(Analyze_Attribute, Attribute_Preelaborable_Initialization):
	Check that the prefix of the attribute is either a formal
	private or derived type, or a composite type declared within the
	visible part of a package or generic package.
	(Eval_Attribute): Perform folding of
	Preelaborable_Initialization attribute based on
	Has_Preelaborable_Initialization applied to the prefix type.
	* sem_ch3.adb (Resolve_Aspects): Add specialized code for
	Preelaborable_Initialization used at the end of a package
	visible part for setting Known_To_Have_Preelab_Init on types
	that are specified with True or that have a conjunction of one
	or more P_I attributes applied to formal types.
	* sem_ch7.adb (Analyze_Package_Specification): On call to
	Has_Preelaborable_Initialization, pass True for new formal
	Formal_Types_Have_Preelab_Init, so that error checking treats
	subcomponents that are declared within types in generics as
	having preelaborable initialization when the subcomponents are
	of formal types.
	* sem_ch13.adb (Analyze_Aspects_At_Freeze_Point): Add test for
	P_I to prevent calling Make_Pragma_From_Boolean_Aspect, since
	this aspect is handled specially and the
	Known_To_Have_Preelab_Init flag will get set on types that have
	the aspect by other means.
	(Analyze_Aspect_Specifications.Analyze_One_Aspect): Add test for
	Aspect_Preelaborable_Initialization for allowing the aspect to
	be specified on formal type declarations.
	(Is_Operational_Item): Treat Attribute_Put_Image as an
	operational attribute.  The need for this was encountered while
	working on these changes.
	* sem_util.ads (Has_Preelaborable_Initialization): Add
	Formal_Types_Have_Preelab_Init as a new formal parameter that
	defaults to False.
	(Is_Conjunction_Of_Formal_Preelab_Init_Attributes): New
	function.
	(Original_View_In_Visible_Part): Moved here from exp_disp.adb,
	so it can be called by Analyze_Attribute.
	* sem_util.adb (Has_Preelaborable_Initialization): Return True
	for formal private and derived types when new formal
	Formal_Types_Have_Preelab_Init is True, and pass along the
	Formal_Types_Have_Preelab_Init flag in the array component case.
	(Check_Components): Pass along Formal_Types_Have_Preelab_Init
	flag on call to Has_Preelaborable_Initialization.
	(Is_Conjunction_Of_Formal_Preelab_Init_Attributes): New function
	that returns True when passed an expression that includes one or
	more attributes for Preelaborable_Initialization applied to
	prefixes that denote formal types.
	(Is_Formal_Preelab_Init_Attribute): New utility function nested
	within Is_Conjunction_Of_Formal_Preelab_Init_Attributes that
	determines whether a node is a P_I attribute applied to a
	generic formal type.
	(Original_View_In_Visible_Part): Moved here from exp_util.adb,
	so it can be called by Analyze_Attribute.
	* snames.ads-tmpl: Add note near the start of spec giving
	details about what needs to be done when adding a name that
	corresponds to both an attribute and a pragma.  Delete existing
	occurrence of Name_Preelaborable_Initialization, and add a note
	comment in the list of Name_* constants at that place,
	indicating that it's included in type Pragma_Id, etc., echoing
	other such comments for names that are both an attribute and a
	pragma.  Insert Name_Preelaborable_Initialization in the
	alphabetized set of Name_* constants corresponding to
	attributes (between First_Attribute_Name and
	Last_Attribute_Name).
	(type Attribute_Id): Add new literal
	Attribute_Preelaborable_Initialization.
	(type Pragma_Id): Move Pragma_Preelaborable_Initialization from
	its current position to the end of the type, in the special set
	of pragma literals that have corresponding atttributes. Add to
	accompanying comment, indicating that functions Get_Pragma_Id
	and Is_Pragma_Name need to be updated when adding a pragma
	literal to the special set.
	* snames.adb-tmpl (Get_Pragma_Id): Add case alternative for
	Pragma_Preelaborable_Initialization.
	(Is_Pragma_Name): Add test for
	Name_Preelaborable_Initialization.

10 files changed, 295 insertions, 57 deletions

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index fc6b0ef..e86cb8f 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -5530,6 +5530,21 @@ package body Exp_Attr is
          end if;
       end Pred;
 
+      ----------------------------------
+      -- Preelaborable_Initialization --
+      ----------------------------------
+
+      when Attribute_Preelaborable_Initialization =>
+
+         --  This attribute should already be folded during analysis, but if
+         --  for some reason it hasn't been, we fold it now.
+
+         Fold_Uint
+           (N,
+            UI_From_Int
+              (Boolean'Pos (Has_Preelaborable_Initialization (Ptyp))),
+            Static => False);
+
       --------------
       -- Priority --
       --------------
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index e9d6e74..4db883c 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -93,10 +93,6 @@ package body Exp_Disp is
    --  Duplicate_Subexpr with an explicit dereference when From is an access
    --  parameter.
 
-   function Original_View_In_Visible_Part (Typ : Entity_Id) return Boolean;
-   --  Check if the type has a private view or if the public view appears in
-   --  the visible part of a package spec.
-
    function Prim_Op_Kind
      (Prim : Entity_Id;
       Typ  : Entity_Id) return Node_Id;
@@ -7394,31 +7390,6 @@ package body Exp_Disp is
       end if;
    end New_Value;
 
-   -----------------------------------
-   -- Original_View_In_Visible_Part --
-   -----------------------------------
-
-   function Original_View_In_Visible_Part (Typ : Entity_Id) return Boolean is
-      Scop : constant Entity_Id := Scope (Typ);
-
-   begin
-      --  The scope must be a package
-
-      if not Is_Package_Or_Generic_Package (Scop) then
-         return False;
-      end if;
-
-      --  A type with a private declaration has a private view declared in
-      --  the visible part.
-
-      if Has_Private_Declaration (Typ) then
-         return True;
-      end if;
-
-      return List_Containing (Parent (Typ)) =
-        Visible_Declarations (Package_Specification (Scop));
-   end Original_View_In_Visible_Part;
-
    ------------------
    -- Prim_Op_Kind --
    ------------------
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index d1a91d8..e37b61a 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -175,6 +175,7 @@ package body Sem_Attr is
    Attribute_22 : constant Attribute_Class_Array := Attribute_Class_Array'(
       Attribute_Enum_Rep                     |
       Attribute_Enum_Val                     => True,
+      Attribute_Preelaborable_Initialization => True,
       others                                 => False);
 
    --  The following array contains all attributes that imply a modification
@@ -5408,6 +5409,45 @@ package body Sem_Attr is
             end if;
          end if;
 
+      ----------------------------------
+      -- Preelaborable_Initialization --
+      ----------------------------------
+
+      when Attribute_Preelaborable_Initialization =>
+         Check_E0;
+         Check_Type;
+
+         --  If we're in an instance, we know that the legality of the
+         --  attribute prefix type was already checked in the generic.
+
+         if not In_Instance then
+
+            --  If the prefix type is a generic formal type, then it must be
+            --  either a formal private type or a formal derived type.
+
+            if Is_Generic_Type (P_Type) then
+               if not Is_Private_Type (P_Type)
+                 and then not Is_Derived_Type (P_Type)
+               then
+                  Error_Attr_P ("formal type prefix of % attribute must be "
+                                 & "formal private or formal derived type");
+               end if;
+
+            --  Otherwise, the prefix type must be a nonformal composite
+            --  type declared within the visible part of a package or
+            --  generic package.
+
+            elsif not Is_Composite_Type (P_Type)
+              or else not Original_View_In_Visible_Part (P_Type)
+            then
+               Error_Attr_P
+                 ("prefix of % attribute must be composite type declared "
+                    & "in visible part of a package or generic package");
+            end if;
+         end if;
+
+         Set_Etype (N, Standard_Boolean);
+
       --------------
       -- Priority --
       --------------
@@ -8182,15 +8222,16 @@ package body Sem_Attr is
       --  is to say if we are within an instantiation. Same processing applies
       --  to selected GNAT attributes.
 
-      elsif (Id = Attribute_Atomic_Always_Lock_Free or else
-             Id = Attribute_Definite                or else
-             Id = Attribute_Descriptor_Size         or else
-             Id = Attribute_Has_Access_Values       or else
-             Id = Attribute_Has_Discriminants       or else
-             Id = Attribute_Has_Tagged_Values       or else
-             Id = Attribute_Lock_Free               or else
-             Id = Attribute_Type_Class              or else
-             Id = Attribute_Unconstrained_Array     or else
+      elsif (Id = Attribute_Atomic_Always_Lock_Free      or else
+             Id = Attribute_Definite                     or else
+             Id = Attribute_Descriptor_Size              or else
+             Id = Attribute_Has_Access_Values            or else
+             Id = Attribute_Has_Discriminants            or else
+             Id = Attribute_Has_Tagged_Values            or else
+             Id = Attribute_Lock_Free                    or else
+             Id = Attribute_Preelaborable_Initialization or else
+             Id = Attribute_Type_Class                   or else
+             Id = Attribute_Unconstrained_Array          or else
              Id = Attribute_Max_Alignment_For_Allocation)
         and then not Is_Generic_Type (P_Entity)
       then
@@ -8315,15 +8356,20 @@ package body Sem_Attr is
       --  unconstrained arrays. Furthermore, it is essential to fold this
       --  in the packed case, since otherwise the value will be incorrect.
 
-      elsif Id = Attribute_Atomic_Always_Lock_Free or else
-            Id = Attribute_Definite                or else
-            Id = Attribute_Descriptor_Size         or else
-            Id = Attribute_Has_Access_Values       or else
-            Id = Attribute_Has_Discriminants       or else
-            Id = Attribute_Has_Tagged_Values       or else
-            Id = Attribute_Lock_Free               or else
-            Id = Attribute_Type_Class              or else
-            Id = Attribute_Unconstrained_Array     or else
+      --  Folding can also be done for Preelaborable_Initialization based on
+      --  whether the prefix type has preelaborable initialization, even though
+      --  the attribute is nonstatic.
+
+      elsif Id = Attribute_Atomic_Always_Lock_Free      or else
+            Id = Attribute_Definite                     or else
+            Id = Attribute_Descriptor_Size              or else
+            Id = Attribute_Has_Access_Values            or else
+            Id = Attribute_Has_Discriminants            or else
+            Id = Attribute_Has_Tagged_Values            or else
+            Id = Attribute_Lock_Free                    or else
+            Id = Attribute_Preelaborable_Initialization or else
+            Id = Attribute_Type_Class                   or else
+            Id = Attribute_Unconstrained_Array          or else
             Id = Attribute_Component_Size
       then
          Static := False;
@@ -9609,6 +9655,17 @@ package body Sem_Attr is
             Fold_Uint (N, Expr_Value (E1) - 1, Static);
          end if;
 
+      ----------------------------------
+      -- Preelaborable_Initialization --
+      ----------------------------------
+
+      when Attribute_Preelaborable_Initialization =>
+         Fold_Uint
+           (N,
+            UI_From_Int
+              (Boolean'Pos (Has_Preelaborable_Initialization (P_Type))),
+            Static);
+
       -----------
       -- Range --
       -----------
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 76859c5..db6a4a4 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1455,9 +1455,17 @@ package body Sem_Ch13 is
                      --  Aspect Full_Access_Only must be analyzed last so that
                      --  aspects Volatile and Atomic, if any, are analyzed.
 
+                     --  Skip creation of pragma Preelaborable_Initialization
+                     --  in the case where the aspect has an expression,
+                     --  because the pragma is only needed for setting flag
+                     --  Known_To_Have_Preelab_Init, which is set by other
+                     --  means following resolution of the aspect expression.
+
                      if A_Id not in Aspect_Export
                                   | Aspect_Full_Access_Only
                                   | Aspect_Import
+                       and then (A_Id /= Aspect_Preelaborable_Initialization
+                                  or else not Present (Expression (ASN)))
                      then
                         Make_Pragma_From_Boolean_Aspect (ASN);
                      end if;
@@ -2915,6 +2923,7 @@ package body Sem_Ch13 is
                             | Aspect_Async_Writers
                             | Aspect_Effective_Reads
                             | Aspect_Effective_Writes
+                            | Aspect_Preelaborable_Initialization
             then
                Error_Msg_Name_1 := Nam;
 
@@ -2951,6 +2960,7 @@ package body Sem_Ch13 is
                                   | Aspect_Async_Writers
                                   | Aspect_Effective_Reads
                                   | Aspect_Effective_Writes
+                                  | Aspect_Preelaborable_Initialization
                   then
                      Error_Msg_N
                        ("aspect % not allowed for formal type declaration",
@@ -13700,6 +13710,7 @@ package body Sem_Ch13 is
                                       | Attribute_Iterable
                                       | Attribute_Iterator_Element
                                       | Attribute_Output
+                                      | Attribute_Put_Image
                                       | Attribute_Read
                                       | Attribute_Variable_Indexing
                                       | Attribute_Write;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index dbcb0ba..c0983f5 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2648,6 +2648,48 @@ package body Sem_Ch3 is
          E := First_Entity (Current_Scope);
          while Present (E) loop
             Resolve_Aspect_Expressions (E);
+
+            --  Now that the aspect expressions have been resolved, if this is
+            --  at the end of the visible declarations, we can set the flag
+            --  Known_To_Have_Preelab_Init properly on types declared in the
+            --  visible part, which is needed for checking whether full types
+            --  in the private part satisfy the Preelaborable_Initialization
+            --  aspect of the partial view. We can't wait for the creation of
+            --  the pragma by Analyze_Aspects_At_Freeze_Point, because the
+            --  freeze point may occur after the end of the package declaration
+            --  (in the case of nested packages).
+
+            if Is_Type (E)
+              and then L = Visible_Declarations (Parent (L))
+              and then Has_Aspect (E, Aspect_Preelaborable_Initialization)
+            then
+               declare
+                  ASN  : constant Node_Id :=
+                    Find_Aspect (E, Aspect_Preelaborable_Initialization);
+                  Expr : constant Node_Id := Expression (ASN);
+               begin
+                  --  Set Known_To_Have_Preelab_Init to True if aspect has no
+                  --  expression, or if the expression is True (or was folded
+                  --  to True), or if the expression is a conjunction of one or
+                  --  more Preelaborable_Initialization attributes applied to
+                  --  formal types and wasn't folded to False. (Note that
+                  --  Is_Conjunction_Of_Formal_Preelab_Init_Attributes goes to
+                  --  Original_Node if needed, hence test for Standard_False.)
+
+                  if not Present (Expr)
+                    or else (Is_Entity_Name (Expr)
+                              and then Entity (Expr) = Standard_True)
+                    or else
+                      (Is_Conjunction_Of_Formal_Preelab_Init_Attributes (Expr)
+                        and then
+                          not (Is_Entity_Name (Expr)
+                                and then Entity (Expr) = Standard_False))
+                  then
+                     Set_Known_To_Have_Preelab_Init (E);
+                  end if;
+               end;
+            end if;
+
             Next_Entity (E);
          end loop;
       end Resolve_Aspects;
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index f30a9aa..30eade2 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1768,11 +1768,16 @@ package body Sem_Ch7 is
          end if;
 
          --  Check preelaborable initialization for full type completing a
-         --  private type for which pragma Preelaborable_Initialization given.
+         --  private type when aspect Preelaborable_Initialization is True.
+         --  We pass True for the parameter Formal_Types_Have_Preelab_Init
+         --  to take into account the rule that presumes that subcomponents
+         --  of generic formal types mentioned in the type's P_I aspect have
+         --  preelaborable initialization (see RM 10.2.1(11.8/5)).
 
          if Is_Type (E)
            and then Must_Have_Preelab_Init (E)
-           and then not Has_Preelaborable_Initialization (E)
+           and then not Has_Preelaborable_Initialization
+                          (E, Formal_Types_Have_Preelab_Init => True)
          then
             Error_Msg_N
               ("full view of & does not have preelaborable initialization", E);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 01a4e2b..78cf674 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -13399,7 +13399,10 @@ package body Sem_Util is
    -- Has_Preelaborable_Initialization --
    --------------------------------------
 
-   function Has_Preelaborable_Initialization (E : Entity_Id) return Boolean is
+   function Has_Preelaborable_Initialization
+     (E                              : Entity_Id;
+      Formal_Types_Have_Preelab_Init : Boolean := False) return Boolean
+   is
       Has_PE : Boolean;
 
       procedure Check_Components (E : Entity_Id);
@@ -13453,7 +13456,9 @@ package body Sem_Util is
             --  component type has PI.
 
             if No (Exp) then
-               if not Has_Preelaborable_Initialization (Etype (Ent)) then
+               if not Has_Preelaborable_Initialization
+                        (Etype (Ent), Formal_Types_Have_Preelab_Init)
+               then
                   Has_PE := False;
                   exit;
                end if;
@@ -13499,7 +13504,8 @@ package body Sem_Util is
       --  Array types have PI if the component type has PI
 
       elsif Is_Array_Type (E) then
-         Has_PE := Has_Preelaborable_Initialization (Component_Type (E));
+         Has_PE := Has_Preelaborable_Initialization
+                     (Component_Type (E), Formal_Types_Have_Preelab_Init);
 
       --  A derived type has preelaborable initialization if its parent type
       --  has preelaborable initialization and (in the case of a derived record
@@ -13510,6 +13516,14 @@ package body Sem_Util is
 
       elsif Is_Derived_Type (E) then
 
+         --  When the rule of RM 10.2.1(11.8/5) applies, we presume a component
+         --  of a generic formal derived type has preelaborable initialization.
+         --  (See comment on spec of Has_Preelaborable_Initialization.)
+
+         if Is_Generic_Type (E) and then Formal_Types_Have_Preelab_Init then
+            return True;
+         end if;
+
          --  If the derived type is a private extension then it doesn't have
          --  preelaborable initialization.
 
@@ -13545,7 +13559,16 @@ package body Sem_Util is
       --  have preelaborable initialization.
 
       elsif Is_Private_Type (E) then
-         return False;
+
+         --  When the rule of RM 10.2.1(11.8/5) applies, we presume a component
+         --  of a generic formal private type has preelaborable initialization.
+         --  (See comment on spec of Has_Preelaborable_Initialization.)
+
+         if Is_Generic_Type (E) and then Formal_Types_Have_Preelab_Init then
+            return True;
+         else
+            return False;
+         end if;
 
       --  Record type has PI if it is non private and all components have PI
 
@@ -16277,6 +16300,49 @@ package body Sem_Util is
         or else Is_Task_Interface (T);
    end Is_Concurrent_Interface;
 
+   ------------------------------------------------------
+   -- Is_Conjunction_Of_Formal_Preelab_Init_Attributes --
+   ------------------------------------------------------
+
+   function Is_Conjunction_Of_Formal_Preelab_Init_Attributes
+     (Expr : Node_Id) return Boolean
+   is
+
+      function Is_Formal_Preelab_Init_Attribute
+        (N : Node_Id) return Boolean;
+      --  Returns True if N is a Preelaborable_Initialization attribute
+      --  applied to a generic formal type, or N's Original_Node is such
+      --  an attribute.
+
+      --------------------------------------
+      -- Is_Formal_Preelab_Init_Attribute --
+      --------------------------------------
+
+      function Is_Formal_Preelab_Init_Attribute
+        (N : Node_Id) return Boolean
+      is
+         Orig_N : constant Node_Id := Original_Node (N);
+
+      begin
+         return Nkind (Orig_N) = N_Attribute_Reference
+           and then Attribute_Name (Orig_N) = Name_Preelaborable_Initialization
+           and then Is_Entity_Name (Prefix (Orig_N))
+           and then Is_Generic_Type (Entity (Prefix (Orig_N)));
+      end Is_Formal_Preelab_Init_Attribute;
+
+   --  Start of Is_Conjunction_Of_Formal_Preelab_Init_Attributes
+
+   begin
+      return Is_Formal_Preelab_Init_Attribute (Expr)
+        or else (Nkind (Expr) = N_Op_And
+                  and then
+                    Is_Conjunction_Of_Formal_Preelab_Init_Attributes
+                      (Left_Opnd (Expr))
+                  and then
+                    Is_Conjunction_Of_Formal_Preelab_Init_Attributes
+                      (Right_Opnd (Expr)));
+   end Is_Conjunction_Of_Formal_Preelab_Init_Attributes;
+
    -----------------------
    -- Is_Constant_Bound --
    -----------------------
@@ -25996,6 +26062,33 @@ package body Sem_Util is
       end if;
    end Original_Corresponding_Operation;
 
+   -----------------------------------
+   -- Original_View_In_Visible_Part --
+   -----------------------------------
+
+   function Original_View_In_Visible_Part
+     (Typ : Entity_Id) return Boolean
+   is
+      Scop : constant Entity_Id := Scope (Typ);
+
+   begin
+      --  The scope must be a package
+
+      if not Is_Package_Or_Generic_Package (Scop) then
+         return False;
+      end if;
+
+      --  A type with a private declaration has a private view declared in
+      --  the visible part.
+
+      if Has_Private_Declaration (Typ) then
+         return True;
+      end if;
+
+      return List_Containing (Parent (Typ)) =
+        Visible_Declarations (Package_Specification (Scop));
+   end Original_View_In_Visible_Part;
+
    -------------------
    -- Output_Entity --
    -------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index b0d6a2a..2c5b2866 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1530,9 +1530,18 @@ package Sem_Util is
    --  non-null), which causes the type to not have preelaborable
    --  initialization.
 
-   function Has_Preelaborable_Initialization (E : Entity_Id) return Boolean;
+   function Has_Preelaborable_Initialization
+     (E                              : Entity_Id;
+      Formal_Types_Have_Preelab_Init : Boolean := False) return Boolean;
    --  Return True iff type E has preelaborable initialization as defined in
    --  Ada 2005 (see AI-161 for details of the definition of this attribute).
+   --  If Formal_Types_Have_Preelab_Init is True, indicates that the function
+   --  should presume that for any subcomponents of formal private or derived
+   --  types, the types have preelaborable initialization (RM 10.2.1(11.8/5)).
+   --  NOTE: The treatment of subcomponents of formal types should only apply
+   --  for types actually specified in the P_I aspect of the outer type, but
+   --  for now we take a more liberal interpretation. This needs addressing,
+   --  perhaps by passing the outermost type instead of the simple flag. ???
 
    function Has_Prefix (N : Node_Id) return Boolean;
    --  Return True if N has attribute Prefix
@@ -1828,6 +1837,13 @@ package Sem_Util is
    --  Returns true if the two specifications of the given
    --  nonoverridable aspect are compatible.
 
+   function Is_Conjunction_Of_Formal_Preelab_Init_Attributes
+     (Expr : Node_Id) return Boolean;
+   --  Returns True if Expr is a Preelaborable_Initialization attribute applied
+   --  to a formal type, or a sequence of two or more such attributes connected
+   --  by "and" operators, or if the Original_Node of Expr or its constituents
+   --  is such an attribute.
+
    function Is_Constant_Bound (Exp : Node_Id) return Boolean;
    --  Exp is the expression for an array bound. Determines whether the
    --  bound is a compile-time known value, or a constant entity, or an
@@ -2845,6 +2861,10 @@ package Sem_Util is
    --  corresponding operation of S is the original corresponding operation of
    --  S2. Otherwise, it is S itself.
 
+   function Original_View_In_Visible_Part (Typ : Entity_Id) return Boolean;
+   --  Returns True if the type Typ has a private view or if the public view
+   --  appears in the visible part of a package spec.
+
    procedure Output_Entity (Id : Entity_Id);
    --  Print entity Id to standard output. The name of the entity appears in
    --  fully qualified form.
diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl
index a1ea3ee..8701ea9 100644
--- a/gcc/ada/snames.adb-tmpl
+++ b/gcc/ada/snames.adb-tmpl
@@ -258,6 +258,8 @@ package body Snames is
             return Pragma_Interrupt_Priority;
          when Name_Lock_Free                        =>
             return Pragma_Lock_Free;
+         when Name_Preelaborable_Initialization     =>
+            return Pragma_Preelaborable_Initialization;
          when Name_Priority                         =>
             return Pragma_Priority;
          when Name_Secondary_Stack_Size             =>
@@ -488,6 +490,7 @@ package body Snames is
         or else N = Name_Interface
         or else N = Name_Interrupt_Priority
         or else N = Name_Lock_Free
+        or else N = Name_Preelaborable_Initialization
         or else N = Name_Priority
         or else N = Name_Secondary_Stack_Size
         or else N = Name_Storage_Size
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index a67623b..34f1cef 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -37,6 +37,17 @@ package Snames is
    --  some exceptions). See the body of Get_Attribute_Id for details. The
    --  same is true of other enumeration types declared in this package.
 
+   --  ALSO NOTE: In the case of a name that corresponds to both an attribute
+   --  and a pragma, the Name_Id must be defined in the attribute section
+   --  (between First_Attribute_Name and Last_Attribute_Name). Also, please
+   --  add a comment in the list of Name_Ids at the point where the name would
+   --  normally appear alphabetically (for an example, see comment starting
+   --  "Note: CPU ..."). The Pragma_Id with that name must be defined in the
+   --  last section of literals for type Pragma_Id (see set of Pragma_Ids that
+   --  require special processing due to matching an attribute name). Finally,
+   --  the bodies of functions Get_Pragma_Id and Is_Pragma_Name must be updated
+   --  to test for each such pragma that shares a name with an attribute.
+
    ------------------
    -- Preset Names --
    ------------------
@@ -624,7 +635,13 @@ package Snames is
    Name_Precondition                   : constant Name_Id := N + $; -- GNAT
    Name_Predicate                      : constant Name_Id := N + $; -- GNAT
    Name_Predicate_Failure              : constant Name_Id := N + $; -- Ada 12
-   Name_Preelaborable_Initialization   : constant Name_Id := N + $; -- Ada 05
+
+   --  Note: Preelaborable_Initialization is not in this list because its name
+   --  matches the name of the corresponding attribute. However, it is included
+   --  in the definition of the type Pragma_Id, and the functions Get_Pragma_Id
+   --  and Is_Pragma_Name correctly recognize and process that pragma name.
+   --  Preelaborable_Initialization is a standard Ada 2005 pragma.
+
    Name_Preelaborate                   : constant Name_Id := N + $;
    Name_Pre_Class                      : constant Name_Id := N + $; -- GNAT
 
@@ -1007,6 +1024,7 @@ package Snames is
    Name_Pool_Address                   : constant Name_Id := N + $; -- GNAT
    Name_Pos                            : constant Name_Id := N + $;
    Name_Position                       : constant Name_Id := N + $;
+   Name_Preelaborable_Initialization   : constant Name_Id := N + $; -- Ada 22
    Name_Priority                       : constant Name_Id := N + $; -- Ada 05
    Name_Range                          : constant Name_Id := N + $;
    Name_Range_Length                   : constant Name_Id := N + $; -- GNAT
@@ -1536,6 +1554,7 @@ package Snames is
       Attribute_Pool_Address,
       Attribute_Pos,
       Attribute_Position,
+      Attribute_Preelaborable_Initialization,
       Attribute_Priority,
       Attribute_Range,
       Attribute_Range_Length,
@@ -1921,7 +1940,6 @@ package Snames is
       Pragma_Precondition,
       Pragma_Predicate,
       Pragma_Predicate_Failure,
-      Pragma_Preelaborable_Initialization,
       Pragma_Preelaborate,
       Pragma_Pre_Class,
       Pragma_Provide_Shift_Operators,
@@ -1974,7 +1992,9 @@ package Snames is
 
       --  The following pragmas are on their own, out of order, because of the
       --  special processing required to deal with the fact that their names
-      --  match existing attribute names.
+      --  match existing attribute names. Note that when a pragma is added in
+      --  this section, functions Get_Pragma_Id and Is_Pragma_Name must be
+      --  updated to account for the new pragma.
 
       Pragma_CPU,
       Pragma_Default_Scalar_Storage_Order,
@@ -1983,6 +2003,7 @@ package Snames is
       Pragma_Interface,
       Pragma_Interrupt_Priority,
       Pragma_Lock_Free,
+      Pragma_Preelaborable_Initialization,
       Pragma_Priority,
       Pragma_Secondary_Stack_Size,
       Pragma_Storage_Size,