@@ -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;
@@ -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
@@ -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
@@ -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;