From b4aa6e2978408f0f45fe1074481cfd4044947ab9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Sun, 16 Feb 2020 07:16:45 -0500 Subject: [PATCH] [Ada] AI12-0287 Legality Rules for null exclusions in renaming are too fierce 2020-06-08 Arnaud Charlet 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. --- gcc/ada/sem_ch12.adb | 34 +++++++++++++++++++++------------- gcc/ada/sem_ch8.adb | 10 ++++------ 2 files changed, 25 insertions(+), 19 deletions(-) diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 76159bc2405..2b38f924133 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -11279,10 +11279,9 @@ package body Sem_Ch12 is -- access type. if Ada_Version < Ada_2005 - or else Ekind (Base_Type (Ftyp)) /= - E_Anonymous_Access_Type - or else Ekind (Base_Type (Etype (Actual))) /= - E_Anonymous_Access_Type + or else Ekind (Base_Type (Ftyp)) not in Anonymous_Access_Kind + or else Ekind (Base_Type (Etype (Actual))) + not in Anonymous_Access_Kind then Error_Msg_NE ("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)); end if; - -- Ada 2005 (AI-423): For a formal object declaration with a null - -- exclusion or an access definition that has a null exclusion: If the - -- actual matching the formal object declaration denotes a generic - -- formal object of another generic unit G, and the instantiation - -- containing the actual occurs within the body of G or within the body - -- of a generic unit declared within the declarative region of G, then - -- the declaration of the formal object of G must have a null exclusion. - -- Otherwise, the subtype of the actual matching the formal object - -- declaration shall exclude null. + -- Ada 2005 (AI-423) refined by AI12-0287: + -- For an object_renaming_declaration with a null_exclusion or an + -- access_definition that has a null_exclusion, the subtype of the + -- object_name shall exclude null. In addition, if the + -- object_renaming_declaration occurs within the body of a generic unit + -- G or within the body of a generic unit declared within the + -- declarative region of generic unit G, then: + -- * if the object_name statically denotes a generic formal object of + -- 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 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 not Has_Null_Exclusion (Actual_Decl) 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 Error_Msg_Sloc := Sloc (Analyzed_Formal); Error_Msg_N diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index fcdc0f36ec0..c65ab5cd95f 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -1278,7 +1278,7 @@ package body Sem_Ch8 is then if not Can_Never_Be_Null (Etype (Nam_Ent)) then Error_Msg_N - ("renamed formal does not exclude `NULL` " + ("object does not exclude `NULL` " & "(RM 8.5.1(4.6/2))", N); 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 Error_Msg_N - ("renamed object does not exclude `NULL` " + ("object does not exclude `NULL` " & "(RM 8.5.1(4.6/2))", N); -- An instance is illegal if it contains a renaming that @@ -1309,8 +1309,7 @@ package body Sem_Ch8 is N_Raise_Constraint_Error then Error_Msg_N - ("renamed actual does not exclude `NULL` " - & "(RM 8.5.1(4.6/2))", N); + ("actual does not exclude `NULL` (RM 8.5.1(4.6/2))", N); -- Finally, if there is a null exclusion, the subtype mark -- must not be null-excluding. @@ -1328,8 +1327,7 @@ package body Sem_Ch8 is and then not Can_Never_Be_Null (Etype (Nam_Ent)) then Error_Msg_N - ("renamed object does not exclude `NULL` " - & "(RM 8.5.1(4.6/2))", N); + ("object does not exclude `NULL` (RM 8.5.1(4.6/2))", N); elsif Has_Null_Exclusion (N) and then No (Access_Definition (N)) -- 2.30.2