[Ada] AI12-0287 Legality Rules for null exclusions in renaming are too fierce
2020-06-08 Arnaud Charlet <charlet@adacore.com> gcc/ada/ * sem_ch12.adb (Instantiate_Object): Relax rules related to null exclusions and generic objects. Handle all anonymous types consistently and not just E_Anonymous_Access_Type. * sem_ch8.adb (Analyze_Object_Renaming): Change wording so that it applies to both renamings and instantiations to avoid confusion.
This commit is contained in:
parent
58c4038810
commit
b4aa6e2978
|
@ -11279,10 +11279,9 @@ package body Sem_Ch12 is
|
||||||
-- access type.
|
-- access type.
|
||||||
|
|
||||||
if Ada_Version < Ada_2005
|
if Ada_Version < Ada_2005
|
||||||
or else Ekind (Base_Type (Ftyp)) /=
|
or else Ekind (Base_Type (Ftyp)) not in Anonymous_Access_Kind
|
||||||
E_Anonymous_Access_Type
|
or else Ekind (Base_Type (Etype (Actual)))
|
||||||
or else Ekind (Base_Type (Etype (Actual))) /=
|
not in Anonymous_Access_Kind
|
||||||
E_Anonymous_Access_Type
|
|
||||||
then
|
then
|
||||||
Error_Msg_NE
|
Error_Msg_NE
|
||||||
("type of actual does not match type of&", Actual, Gen_Obj);
|
("type of actual does not match type of&", Actual, Gen_Obj);
|
||||||
|
@ -11477,15 +11476,19 @@ package body Sem_Ch12 is
|
||||||
Actual_Decl := Parent (Entity (Actual));
|
Actual_Decl := Parent (Entity (Actual));
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Ada 2005 (AI-423): For a formal object declaration with a null
|
-- Ada 2005 (AI-423) refined by AI12-0287:
|
||||||
-- exclusion or an access definition that has a null exclusion: If the
|
-- For an object_renaming_declaration with a null_exclusion or an
|
||||||
-- actual matching the formal object declaration denotes a generic
|
-- access_definition that has a null_exclusion, the subtype of the
|
||||||
-- formal object of another generic unit G, and the instantiation
|
-- object_name shall exclude null. In addition, if the
|
||||||
-- containing the actual occurs within the body of G or within the body
|
-- object_renaming_declaration occurs within the body of a generic unit
|
||||||
-- of a generic unit declared within the declarative region of G, then
|
-- G or within the body of a generic unit declared within the
|
||||||
-- the declaration of the formal object of G must have a null exclusion.
|
-- declarative region of generic unit G, then:
|
||||||
-- Otherwise, the subtype of the actual matching the formal object
|
-- * if the object_name statically denotes a generic formal object of
|
||||||
-- declaration shall exclude null.
|
-- mode in out of G, then the declaration of that object shall have a
|
||||||
|
-- null_exclusion;
|
||||||
|
-- * if the object_name statically denotes a call of a generic formal
|
||||||
|
-- function of G, then the declaration of the result of that function
|
||||||
|
-- shall have a null_exclusion.
|
||||||
|
|
||||||
if Ada_Version >= Ada_2005
|
if Ada_Version >= Ada_2005
|
||||||
and then Present (Actual_Decl)
|
and then Present (Actual_Decl)
|
||||||
|
@ -11494,6 +11497,11 @@ package body Sem_Ch12 is
|
||||||
and then Nkind (Analyzed_Formal) = N_Formal_Object_Declaration
|
and then Nkind (Analyzed_Formal) = N_Formal_Object_Declaration
|
||||||
and then not Has_Null_Exclusion (Actual_Decl)
|
and then not Has_Null_Exclusion (Actual_Decl)
|
||||||
and then Has_Null_Exclusion (Analyzed_Formal)
|
and then Has_Null_Exclusion (Analyzed_Formal)
|
||||||
|
and then Ekind (Defining_Identifier (Analyzed_Formal))
|
||||||
|
= E_Generic_In_Out_Parameter
|
||||||
|
and then ((In_Generic_Scope (Entity (Actual))
|
||||||
|
and then In_Package_Body (Scope (Entity (Actual))))
|
||||||
|
or else not Can_Never_Be_Null (Etype (Actual)))
|
||||||
then
|
then
|
||||||
Error_Msg_Sloc := Sloc (Analyzed_Formal);
|
Error_Msg_Sloc := Sloc (Analyzed_Formal);
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
|
|
|
@ -1278,7 +1278,7 @@ package body Sem_Ch8 is
|
||||||
then
|
then
|
||||||
if not Can_Never_Be_Null (Etype (Nam_Ent)) then
|
if not Can_Never_Be_Null (Etype (Nam_Ent)) then
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("renamed formal does not exclude `NULL` "
|
("object does not exclude `NULL` "
|
||||||
& "(RM 8.5.1(4.6/2))", N);
|
& "(RM 8.5.1(4.6/2))", N);
|
||||||
|
|
||||||
elsif In_Package_Body (Scope (Id)) then
|
elsif In_Package_Body (Scope (Id)) then
|
||||||
|
@ -1292,7 +1292,7 @@ package body Sem_Ch8 is
|
||||||
|
|
||||||
elsif not Can_Never_Be_Null (Etype (Nam_Ent)) then
|
elsif not Can_Never_Be_Null (Etype (Nam_Ent)) then
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("renamed object does not exclude `NULL` "
|
("object does not exclude `NULL` "
|
||||||
& "(RM 8.5.1(4.6/2))", N);
|
& "(RM 8.5.1(4.6/2))", N);
|
||||||
|
|
||||||
-- An instance is illegal if it contains a renaming that
|
-- An instance is illegal if it contains a renaming that
|
||||||
|
@ -1309,8 +1309,7 @@ package body Sem_Ch8 is
|
||||||
N_Raise_Constraint_Error
|
N_Raise_Constraint_Error
|
||||||
then
|
then
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("renamed actual does not exclude `NULL` "
|
("actual does not exclude `NULL` (RM 8.5.1(4.6/2))", N);
|
||||||
& "(RM 8.5.1(4.6/2))", N);
|
|
||||||
|
|
||||||
-- Finally, if there is a null exclusion, the subtype mark
|
-- Finally, if there is a null exclusion, the subtype mark
|
||||||
-- must not be null-excluding.
|
-- must not be null-excluding.
|
||||||
|
@ -1328,8 +1327,7 @@ package body Sem_Ch8 is
|
||||||
and then not Can_Never_Be_Null (Etype (Nam_Ent))
|
and then not Can_Never_Be_Null (Etype (Nam_Ent))
|
||||||
then
|
then
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("renamed object does not exclude `NULL` "
|
("object does not exclude `NULL` (RM 8.5.1(4.6/2))", N);
|
||||||
& "(RM 8.5.1(4.6/2))", N);
|
|
||||||
|
|
||||||
elsif Has_Null_Exclusion (N)
|
elsif Has_Null_Exclusion (N)
|
||||||
and then No (Access_Definition (N))
|
and then No (Access_Definition (N))
|
||||||
|
|
Loading…
Reference in New Issue