OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] AI12-0282: shared variable control aspects on formal types 

2019-12-18  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* 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.

From-SVN: r279512
This commit is contained in:
Ed Schonberg 2019-12-18 07:14:54 +00:00 committed by Pierre-Marie de Rodat
parent 2b0451b772
commit 64c6e3673a
5 changed files with 172 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/ada/ChangeLog
View File

@ -1,3 +1,23 @@
2019-12-18 Ed Schonberg <schonberg@adacore.com>
* 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 <ebotcazou@adacore.com>
* cstand.adb (Create_Standard): Remove duplicate line and

13
gcc/ada/par-ch12.adb
View File

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

96
gcc/ada/sem_ch12.adb
View File

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

32
gcc/ada/sem_ch13.adb
View File

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

28
gcc/ada/sem_prag.adb
View File

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