diff options
Diffstat (limited to 'gcc/ada/sem_ch13.adb')
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 159 |
1 files changed, 95 insertions, 64 deletions
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 27faac2..1a80b3a 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1210,9 +1210,11 @@ package body Sem_Ch13 is Set_Is_Volatile (E); end if; - -- Volatile_Full_Access + -- Volatile_Full_Access (also Full_Access_Only) - when Aspect_Volatile_Full_Access => + when Aspect_Volatile_Full_Access + | Aspect_Full_Access_Only + => if Is_Volatile_Full_Access (P) then Set_Is_Volatile_Full_Access (E); end if; @@ -1308,7 +1310,9 @@ package body Sem_Ch13 is return; end if; - when Aspect_Volatile_Full_Access => + when Aspect_Volatile_Full_Access + | Aspect_Full_Access_Only + => if not Is_Volatile_Full_Access (Par) then return; end if; @@ -1326,23 +1330,28 @@ package body Sem_Ch13 is -- Local variables - Prag : Node_Id; + Prag : Node_Id; + P_Name : Name_Id; -- Start of processing for Make_Pragma_From_Boolean_Aspect begin - -- Note that we know Expr is present, because for a missing Expr - -- argument, we knew it was True and did not need to delay the - -- evaluation to the freeze point. - - if Is_False (Static_Boolean (Expr)) then + if Present (Expr) and then Is_False (Static_Boolean (Expr)) then Check_False_Aspect_For_Derived_Type; else + -- There is no Full_Access_Only pragma so use VFA instead + + if A_Name = Name_Full_Access_Only then + P_Name := Name_Volatile_Full_Access; + else + P_Name := A_Name; + end if; + Prag := Make_Pragma (Loc, Pragma_Identifier => - Make_Identifier (Sloc (Ident), Chars (Ident)), + Make_Identifier (Sloc (Ident), P_Name), Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Sloc (Ident), Expression => New_Occurrence_Of (Ent, Sloc (Ident))))); @@ -1427,12 +1436,13 @@ package body Sem_Ch13 is -- Analyze_Aspect_Export_Import, but is not analyzed as -- the complete analysis must happen now. - if A_Id = Aspect_Export or else A_Id = Aspect_Import then - null; - - -- Otherwise create a corresponding pragma + -- Aspect Full_Access_Only must be analyzed last so that + -- aspects Volatile and Atomic, if any, are analyzed. - else + if A_Id /= Aspect_Export + and then A_Id /= Aspect_Import + and then A_Id /= Aspect_Full_Access_Only + then Make_Pragma_From_Boolean_Aspect (ASN); end if; @@ -1499,6 +1509,25 @@ package body Sem_Ch13 is Next_Rep_Item (ASN); end loop; + -- Make a second pass for a Full_Access_Only entry + + ASN := First_Rep_Item (E); + while Present (ASN) loop + if Nkind (ASN) = N_Aspect_Specification then + exit when Entity (ASN) /= E; + + if Get_Aspect_Id (ASN) = Aspect_Full_Access_Only then + Make_Pragma_From_Boolean_Aspect (ASN); + Ritem := Aspect_Rep_Item (ASN); + if Present (Ritem) then + Analyze (Ritem); + end if; + end if; + end if; + + Next_Rep_Item (ASN); + end loop; + -- This is where we inherit delayed rep aspects from our parent. Note -- that if we fell out of the above loop with ASN non-empty, it means -- we hit an aspect for an entity other than E, and it must be the @@ -2683,6 +2712,7 @@ package body Sem_Ch13 is is Args : List_Id := Pragma_Argument_Associations; Aitem : Node_Id; + begin -- We should never get here if aspect was disabled @@ -2870,23 +2900,33 @@ package body Sem_Ch13 is case Aspect_Delay (A_Id) is when Always_Delay => - Delay_Required := True; + -- For Boolean aspects, do not delay if no expression + + if A_Id in Boolean_Aspects | Library_Unit_Aspects then + Delay_Required := Present (Expr); + else + Delay_Required := True; + end if; when Never_Delay => Delay_Required := False; when Rep_Aspect => - -- If expression has the form of an integer literal, then - -- do not delay, since we know the value cannot change. - -- This optimization catches most rep clause cases. - - -- For Boolean aspects, don't delay if no expression + -- For Boolean aspects, do not delay if no expression except + -- for Full_Access_Only because we need to process it after + -- Volatile and Atomic, which can be independently delayed. - if A_Id in Boolean_Aspects and then No (Expr) then + if A_Id in Boolean_Aspects + and then A_Id /= Aspect_Full_Access_Only + and then No (Expr) + then Delay_Required := False; - -- For non-Boolean aspects, don't delay if integer literal + -- For non-Boolean aspects, if the expression has the form + -- of an integer literal, then do not delay, since we know + -- the value cannot change. This optimization catches most + -- rep clause cases. elsif A_Id not in Boolean_Aspects and then Present (Expr) @@ -2894,7 +2934,7 @@ package body Sem_Ch13 is then Delay_Required := False; - -- For Alignment and various Size aspects, don't delay for + -- For Alignment and various Size aspects, do not delay for -- an attribute reference whose prefix is Standard, for -- example Standard'Maximum_Alignment or Standard'Word_Size. @@ -4491,6 +4531,15 @@ package body Sem_Ch13 is goto Continue; + -- Ada 202x (AI12-0363): Full_Access_Only + + elsif A_Id = Aspect_Full_Access_Only then + if Ada_Version < Ada_2020 then + Error_Msg_N + ("aspect % is an Ada 202x feature", Aspect); + Error_Msg_N ("\compile with -gnat2020", Aspect); + end if; + -- Ada 202x (AI12-0075): static expression functions elsif A_Id = Aspect_Static then @@ -4525,10 +4574,9 @@ package body Sem_Ch13 is goto Continue; end if; - -- Cases where we do not delay, includes all cases where the - -- expression is missing other than the above cases. + -- Cases where we do not delay - if not Delay_Required or else No (Expr) then + if not Delay_Required then -- Exclude aspects Export and Import because their pragma -- syntax does not map directly to a Boolean aspect. @@ -4543,8 +4591,6 @@ package body Sem_Ch13 is Pragma_Name => Chars (Id)); end if; - Delay_Required := False; - -- In general cases, the corresponding pragma/attribute -- definition clause will be inserted later at the freezing -- point, and we do not need to build it now. @@ -10447,7 +10493,10 @@ package body Sem_Ch13 is Freeze_Expr : constant Node_Id := Expression (ASN); -- Expression from call to Check_Aspect_At_Freeze_Point. - T : constant Entity_Id := Etype (Original_Node (Freeze_Expr)); + T : constant Entity_Id := + (if Present (Freeze_Expr) + then Etype (Original_Node (Freeze_Expr)) + else Empty); -- Type required for preanalyze call. We use the original expression to -- get the proper type, to prevent cascaded errors when the expression -- is constant-folded. @@ -10591,12 +10640,12 @@ package body Sem_Ch13 is Set_Parent (End_Decl_Expr, ASN); - -- In a generic context the original aspect expressions have not + -- In a generic context the original aspect expressions have not -- been preanalyzed, so do it now. There are no conformance checks -- to perform in this case. As before, we have to make components -- visible for aspects that may reference them. - if No (T) then + if Present (Freeze_Expr) and then No (T) then if A_Id = Aspect_Dynamic_Predicate or else A_Id = Aspect_Predicate or else A_Id = Aspect_Priority @@ -10636,7 +10685,7 @@ package body Sem_Ch13 is elsif A_Id = Aspect_Predicate_Failure then Preanalyze_Spec_Expression (End_Decl_Expr, Standard_String); - else + elsif Present (End_Decl_Expr) then Preanalyze_Spec_Expression (End_Decl_Expr, T); end if; @@ -10926,7 +10975,9 @@ package body Sem_Ch13 is -- Do the preanalyze call - Preanalyze_Spec_Expression (Expression (ASN), T); + if Present (Expression (ASN)) then + Preanalyze_Spec_Expression (Expression (ASN), T); + end if; end Check_Aspect_At_Freeze_Point; ----------------------------------- @@ -13129,9 +13180,6 @@ package body Sem_Ch13 is -- specification node whose correponding pragma (if any) is present in -- the Rep Item chain of the entity it has been specified to. - function Rep_Item_Entity (Rep_Item : Node_Id) return Entity_Id; - -- Return the entity for which Rep_Item is specified - -------------------------------------------------- -- Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item -- -------------------------------------------------- @@ -13142,26 +13190,10 @@ package body Sem_Ch13 is begin return Nkind (Rep_Item) = N_Pragma - or else Present_In_Rep_Item - (Entity (Rep_Item), Aspect_Rep_Item (Rep_Item)); + or else + Present_In_Rep_Item (Entity (Rep_Item), Aspect_Rep_Item (Rep_Item)); end Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item; - --------------------- - -- Rep_Item_Entity -- - --------------------- - - function Rep_Item_Entity (Rep_Item : Node_Id) return Entity_Id is - begin - if Nkind (Rep_Item) = N_Aspect_Specification then - return Entity (Rep_Item); - - else - pragma Assert - (Nkind (Rep_Item) in N_Attribute_Definition_Clause | N_Pragma); - return Entity (Name (Rep_Item)); - end if; - end Rep_Item_Entity; - -- Start of processing for Inherit_Aspects_At_Freeze_Point begin @@ -13287,10 +13319,12 @@ package body Sem_Ch13 is Set_Treat_As_Volatile (Typ); end if; - -- Volatile_Full_Access + -- Volatile_Full_Access and Full_Access_Only if not Has_Rep_Item (Typ, Name_Volatile_Full_Access, False) - and then Has_Rep_Pragma (Typ, Name_Volatile_Full_Access) + and then not Has_Rep_Item (Typ, Name_Full_Access_Only, False) + and then (Has_Rep_Item (Typ, Name_Volatile_Full_Access) + or else Has_Rep_Item (Typ, Name_Full_Access_Only)) and then Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item (Get_Rep_Item (Typ, Name_Volatile_Full_Access)) then @@ -13347,23 +13381,20 @@ package body Sem_Ch13 is -- Bit_Order - if Is_Record_Type (Typ) then + if Is_Record_Type (Typ) and then Typ = Bas_Typ then if not Has_Rep_Item (Typ, Name_Bit_Order, False) and then Has_Rep_Item (Typ, Name_Bit_Order) then Set_Reverse_Bit_Order (Bas_Typ, - Reverse_Bit_Order (Rep_Item_Entity - (Get_Rep_Item (Typ, Name_Bit_Order)))); + Reverse_Bit_Order + (Implementation_Base_Type (Etype (Bas_Typ)))); end if; end if; -- Scalar_Storage_Order - -- Note: the aspect is specified on a first subtype, but recorded - -- in a flag of the base type! - if (Is_Record_Type (Typ) or else Is_Array_Type (Typ)) - and then Typ = Bas_Typ + and then Typ = Bas_Typ then -- For a type extension, always inherit from parent; otherwise -- inherit if no default applies. Note: we do not check for |