diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9900e9ad5f1..fd3d0be0edd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2019-12-18 Ed Schonberg + + * par-ch12.adb (P_Formal_Derived_Type_Definition): In Ada_2020 + the keyword WITH can indicate the start of aspect specifications + and not a private type extension. + * sem_ch12.adb (Analyze_Formal_Type): Indicate that it is a + first subtype. + (Instantiate_Type): New procedure + Check_Shared_Variable_Control_Aspects to verify matching rules + between formal and actual types. Note that an array type with + aspect Atomic_Components is considered compatible with an array + type whose component type is Atomic, even though the array types + do not carry the same aspect. + * sem_ch13.adb (Analyze_One_Aspect): Allow shared variable + control aspects to appear on formal types. + (Rep_Item_Too_Early): Exclude aspects on formal types. + * sem_prag.adb (Mark_Type): Handle properly pragmas that come + from aspects on formal types. + (Analyze_Pragma, case Atomic_Components): Handle formal types. + 2019-12-18 Eric Botcazou * cstand.adb (Create_Standard): Remove duplicate line and diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb index 3216927a9e6..0ecac2e7cce 100644 --- a/gcc/ada/par-ch12.adb +++ b/gcc/ada/par-ch12.adb @@ -971,9 +971,16 @@ package body Ch12 is end if; if Token = Tok_With then - Scan; -- past WITH - Set_Private_Present (Def_Node, True); - T_Private; + + if Ada_Version >= Ada_2020 and Token /= Tok_Private then + -- Formal type has aspect specifications, parsed later. + return Def_Node; + + else + Scan; -- past WITH + Set_Private_Present (Def_Node, True); + T_Private; + end if; elsif Token = Tok_Tagged then Scan; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 5b7ce936281..dc3a3c25446 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3410,7 +3410,11 @@ package body Sem_Ch12 is raise Program_Error; end case; + -- A formal type declaration declares a type and its first + -- subtype. + Set_Is_Generic_Type (T); + Set_Is_First_Subtype (T); if Has_Aspects (N) then Analyze_Aspect_Specifications (N, T); @@ -12178,6 +12182,10 @@ package body Sem_Ch12 is Loc : Source_Ptr; Subt : Entity_Id; + procedure Check_Shared_Variable_Control_Aspects; + -- Ada_2020: Verify that shared variable control aspects (RM C.6) + -- that may be specified for a formal type are obeyed by the actual. + procedure Diagnose_Predicated_Actual; -- There are a number of constructs in which a discrete type with -- predicates is illegal, e.g. as an index in an array type declaration. @@ -12202,6 +12210,79 @@ package body Sem_Ch12 is -- Check that base types are the same and that the subtypes match -- statically. Used in several of the above. + -------------------------------------------- + -- Check_Shared_Variable_Control_Aspects -- + -------------------------------------------- + + -- Ada_2020: Verify that shared variable control aspects (RM C.6) + -- that may be specified for the formal are obeyed by the actual. + + procedure Check_Shared_Variable_Control_Aspects is + begin + if Ada_Version >= Ada_2020 then + if Is_Atomic (A_Gen_T) and then not Is_Atomic (Act_T) then + Error_Msg_NE + ("actual for& must be an atomic type", Actual, A_Gen_T); + end if; + + if Is_Volatile (A_Gen_T) and then not Is_Volatile (Act_T) then + Error_Msg_NE + ("actual for& must be a Volatile type", Actual, A_Gen_T); + end if; + + if + Is_Independent (A_Gen_T) and then not Is_Independent (Act_T) + then + Error_Msg_NE + ("actual for& must be an Independent type", Actual, A_Gen_T); + end if; + + -- We assume that an array type whose atomic component type + -- is Atomic is equivalent to an array type with the explicit + -- aspect Has_Atomic_Components. This is a reasonable inference + -- from the intent of AI12-0282, and makes it legal to use an + -- actual that does not have the identical aspect as the formal. + + if Has_Atomic_Components (A_Gen_T) + and then not Has_Atomic_Components (Act_T) + then + if Is_Array_Type (Act_T) + and then Is_Atomic (Component_Type (Act_T)) + then + null; + + else + Error_Msg_NE + ("actual for& must have atomic components", + Actual, A_Gen_T); + end if; + end if; + + if Has_Independent_Components (A_Gen_T) + and then not Has_Independent_Components (Act_T) + then + Error_Msg_NE + ("actual for& must have independent components", + Actual, A_Gen_T); + end if; + + if Has_Volatile_Components (A_Gen_T) + and then not Has_Volatile_Components (Act_T) + then + if Is_Array_Type (Act_T) + and then Is_Volatile (Component_Type (Act_T)) + then + null; + + else + Error_Msg_NE + ("actual for& must have volatile components", + Actual, A_Gen_T); + end if; + end if; + end if; + end Check_Shared_Variable_Control_Aspects; + --------------------------------- -- Diagnose_Predicated_Actual -- --------------------------------- @@ -12820,12 +12901,21 @@ package body Sem_Ch12 is -- Perform atomic/volatile checks (RM C.6(12)). Note that AI05-0218-1 -- removes the second instance of the phrase "or allow pass by copy". - if Is_Atomic (Act_T) and then not Is_Atomic (Ancestor) then + -- In Ada_2020 the aspect may be specified explicitly for the formal + -- regardless of whether an ancestor obeys it. + + if Is_Atomic (Act_T) + and then not Is_Atomic (Ancestor) + and then not Is_Atomic (A_Gen_T) + then Error_Msg_N ("cannot have atomic actual type for non-atomic formal type", Actual); - elsif Is_Volatile (Act_T) and then not Is_Volatile (Ancestor) then + elsif Is_Volatile (Act_T) + and then not Is_Volatile (Ancestor) + and then not Is_Volatile (A_Gen_T) + then Error_Msg_N ("cannot have volatile actual type for non-volatile formal type", Actual); @@ -13504,6 +13594,8 @@ package body Sem_Ch12 is end if; end if; + Check_Shared_Variable_Control_Aspects; + if Error_Posted (Act_T) then null; else diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 8ca731dc284..5944ba5453d 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2131,12 +2131,27 @@ package body Sem_Ch13 is Aspect); end if; - -- Not allowed for formal type declarations + -- Not allowed for formal type declarations in previous + -- versions of the language. Allowed for them only for + -- shared variable control aspects. if Nkind (N) = N_Formal_Type_Declaration then - Error_Msg_N - ("aspect % not allowed for formal type declaration", - Aspect); + if Ada_Version < Ada_2020 then + Error_Msg_N + ("aspect % not allowed for formal type declaration", + Aspect); + + elsif A_Id /= Aspect_Atomic + and then A_Id /= Aspect_Volatile + and then A_Id /= Aspect_Independent + and then A_Id /= Aspect_Atomic_Components + and then A_Id /= Aspect_Independent_Components + and then A_Id /= Aspect_Volatile_Components + then + Error_Msg_N + ("aspect % not allowed for formal type declaration", + Aspect); + end if; end if; end if; @@ -12837,8 +12852,13 @@ package body Sem_Ch13 is and then (Nkind (N) /= N_Pragma or else Get_Pragma_Id (N) /= Pragma_Convention) then - Error_Msg_N ("representation item not allowed for generic type", N); - return True; + if Ada_Version < Ada_2020 then + Error_Msg_N + ("representation item not allowed for generic type", N); + return True; + else + return False; + end if; end if; -- Otherwise check for incomplete type diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index b2177102781..2369d64f732 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7562,13 +7562,19 @@ package body Sem_Prag is -- Attribute belongs on the base type. If the view of the type is -- currently private, it also belongs on the underlying type. + -- In Ada_2020, the pragma can apply to a formal type, for which + -- there may be no underlying type. + if Prag_Id = Pragma_Atomic or else Prag_Id = Pragma_Shared or else Prag_Id = Pragma_Volatile_Full_Access then Set_Atomic_VFA (Ent); Set_Atomic_VFA (Base_Type (Ent)); - Set_Atomic_VFA (Underlying_Type (Ent)); + + if not Is_Generic_Type (Ent) then + Set_Atomic_VFA (Underlying_Type (Ent)); + end if; end if; -- Atomic/Shared/Volatile_Full_Access imply Independent @@ -7576,10 +7582,13 @@ package body Sem_Prag is if Prag_Id /= Pragma_Volatile then Set_Is_Independent (Ent); Set_Is_Independent (Base_Type (Ent)); - Set_Is_Independent (Underlying_Type (Ent)); - if Prag_Id = Pragma_Independent then - Record_Independence_Check (N, Base_Type (Ent)); + if not Is_Generic_Type (Ent) then + Set_Is_Independent (Underlying_Type (Ent)); + + if Prag_Id = Pragma_Independent then + Record_Independence_Check (N, Base_Type (Ent)); + end if; end if; end if; @@ -7588,10 +7597,13 @@ package body Sem_Prag is if Prag_Id /= Pragma_Independent then Set_Is_Volatile (Ent); Set_Is_Volatile (Base_Type (Ent)); - Set_Is_Volatile (Underlying_Type (Ent)); + + if not Is_Generic_Type (Ent) then + Set_Is_Volatile (Underlying_Type (Ent)); + Set_Treat_As_Volatile (Underlying_Type (Ent)); + end if; Set_Treat_As_Volatile (Ent); - Set_Treat_As_Volatile (Underlying_Type (Ent)); end if; -- Apply Volatile to the composite type's individual components, @@ -14076,6 +14088,9 @@ package body Sem_Prag is Ekind (E) = E_Variable) and then Nkind (Object_Definition (D)) = N_Constrained_Array_Definition) + or else + (Ada_Version >= Ada_2020 + and then Nkind (D) = N_Formal_Type_Declaration) then -- The flag is set on the base type, or on the object @@ -14090,6 +14105,7 @@ package body Sem_Prag is Check_Atomic_VFA (Component_Type (Etype (E)), VFA => False); end if; + Set_Has_Atomic_Components (E); Set_Has_Independent_Components (E); end if;