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

[Ada] Ada 2020 AI12-0401: Renaming of qualified expression of variable 

gcc/ada/

	* sem_ch8.adb (Analyze_Object_Renaming): Update check for
	AI12-0401.
This commit is contained in:
Arnaud Charlet 2020-12-14 05:10:21 -05:00 committed by Pierre-Marie de Rodat
parent 0b8d4694de
commit 3c837e5bf7
1 changed files with 48 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
gcc/ada/sem_ch8.adb
View File

@ -759,6 +759,7 @@ package body Sem_Ch8 is
Dec : Node_Id;
T : Entity_Id;
T2 : Entity_Id;
Q : Node_Id;
procedure Check_Constrained_Object;
-- If the nominal type is unconstrained but the renamed object is
@ -1074,17 +1075,55 @@ package body Sem_Ch8 is
-- Check against AI12-0401 here before Resolve may rewrite Nam and
-- potentially generate spurious warnings.
-- In the case where the object_name is a qualified_expression with
-- a nominal subtype T and whose expression is a name that denotes
-- an object Q:
-- * if T is an elementary subtype, then:
-- * Q shall be a constant other than a dereference of an access
-- type; or
-- * the nominal subtype of Q shall be statically compatible with
-- T; or
-- * T shall statically match the base subtype of its type if
-- scalar, or the first subtype of its type if an access type.
-- * if T is a composite subtype, then Q shall be known to be
-- constrained or T shall statically match the first subtype of
-- its type.
if Nkind (Nam) = N_Qualified_Expression
and then Is_Variable (Expression (Nam))
and then not
(Subtypes_Statically_Match (T, Etype (Expression (Nam)))
or else
Subtypes_Statically_Match (Base_Type (T), Etype (Nam)))
and then Is_Object_Reference (Expression (Nam))
then
Error_Msg_N
("subtype of renamed qualified expression does not " &
"statically match", N);
return;
Q := Expression (Nam);
if (Is_Elementary_Type (T)
and then
not ((not Is_Variable (Q)
and then Nkind (Q) /= N_Explicit_Dereference)
or else Subtypes_Statically_Compatible (Etype (Q), T)
or else (Is_Scalar_Type (T)
and then Subtypes_Statically_Match
(T, Base_Type (T)))
or else (Is_Access_Type (T)
and then Subtypes_Statically_Match
(T, First_Subtype (T)))))
or else (Is_Composite_Type (T)
and then
-- If Q is an aggregate, Is_Constrained may not be set
-- yet and its type may not be resolved yet.
-- This doesn't quite correspond to the complex notion
-- of "known to be constrained" but this is good enough
-- for a rule which is in any case too complex.
not (Is_Constrained (Etype (Q))
or else Nkind (Q) = N_Aggregate
or else Subtypes_Statically_Match
(T, First_Subtype (T))))
then
Error_Msg_N
("subtype of renamed qualified expression does not " &
"statically match", N);
return;
end if;
end if;
Resolve (Nam, T);