From: Gary Dismukes Date: Tue, 22 Jun 2021 04:47:00 +0000 (-0400) Subject: [Ada] Implementation of Preelaborable_Initialization attribute for AI12-0409 X-Git-Tag: basepoints/gcc-13~4616 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=3450ded1eddb35b7f9030c5545d1e542cef5f8b2;p=thirdparty%2Fgcc.git [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. --- diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index fc6b0ef80970..e86cb8f028fe 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 e9d6e744d2cf..4db883cd296b 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 d1a91d8864ec..e37b61a4b4d4 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 76859c5463fb..db6a4a47c414 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 dbcb0babb5d7..c0983f5c2589 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 f30a9aa396c2..30eade2cb3b8 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 01a4e2bc8af4..78cf674aee34 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 b0d6a2a2ef35..2c5b2866bc0f 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 a1ea3ee84786..8701ea928bdc 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 a67623b788b6..34f1cef946d2 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,