From 4459999864a87462a7dc4a877238eb2cac0d1b3e Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sat, 21 Mar 2020 13:25:45 +0100 Subject: [PATCH] [Ada] Small cleanup in handling of Ada 2012 implicit dereferences 2020-06-12 Eric Botcazou gcc/ada/ * sem_ch4.adb (Try_Container_Indexing): Replace call to First_Discriminant by Get_Reference_Discriminant to get the reference discriminant. * sem_ch13.adb (Check_Indexing_Functions): Likewise. * sem_ch5.adb (Preanalyze_Range): Call Get_Reference_Discriminant to get the reference discriminant. * sem_util.adb (Is_OK_Variable_For_Out_Formal): Treat all Ada 2012 implicit dereferences in only one place. (Is_Variable): Minor tweak. --- gcc/ada/sem_ch13.adb | 5 +++-- gcc/ada/sem_ch4.adb | 3 ++- gcc/ada/sem_ch5.adb | 17 ++--------------- gcc/ada/sem_util.adb | 34 ++++++---------------------------- 4 files changed, 13 insertions(+), 46 deletions(-) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 4b042d8b678..e9473af1eb2 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4759,9 +4759,10 @@ package body Sem_Ch13 is end if; else - if Has_Implicit_Dereference (Ret_Type) + if Has_Implicit_Dereference (Ret_Type) and then not - Is_Access_Constant (Etype (First_Discriminant (Ret_Type))) + Is_Access_Constant + (Etype (Get_Reference_Discriminant (Ret_Type))) then Illegal_Indexing ("constant indexing must return an access to constant"); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index bb0017ed7be..7bdb0d10b07 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -8097,7 +8097,8 @@ package body Sem_Ch4 is -- as such and retry. if Has_Implicit_Dereference (Pref_Typ) then - Build_Explicit_Dereference (Prefix, First_Discriminant (Pref_Typ)); + Build_Explicit_Dereference + (Prefix, Get_Reference_Discriminant (Pref_Typ)); return Try_Container_Indexing (N, Prefix, Exprs); -- Otherwise this is definitely not container indexing diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 35119fb686f..57939028869 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -4375,21 +4375,8 @@ package body Sem_Ch5 is -- visible in the loop. elsif Has_Implicit_Dereference (Etype (R_Copy)) then - declare - Disc : Entity_Id; - - begin - Disc := First_Discriminant (Typ); - while Present (Disc) loop - if Has_Implicit_Dereference (Disc) then - Build_Explicit_Dereference (R_Copy, Disc); - exit; - end if; - - Next_Discriminant (Disc); - end loop; - end; - + Build_Explicit_Dereference + (R_Copy, Get_Reference_Discriminant (Etype (R_Copy))); end if; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 3ae82645ffb..948ee60d91e 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -16915,10 +16915,9 @@ package body Sem_Util is -- check whether the context requires an access_to_variable type. elsif Nkind (AV) = N_Explicit_Dereference - and then Ada_Version >= Ada_2012 - and then Nkind (Original_Node (AV)) = N_Indexed_Component and then Present (Etype (Original_Node (AV))) and then Has_Implicit_Dereference (Etype (Original_Node (AV))) + and then Ada_Version >= Ada_2012 then return not Is_Access_Constant (Etype (Prefix (AV))); @@ -16976,28 +16975,7 @@ package body Sem_Util is -- but we still want to allow the conversion if it converts a variable). elsif Is_Rewrite_Substitution (AV) then - - -- In Ada 2012, the explicit dereference may be a rewritten call to a - -- Reference function. - - if Ada_Version >= Ada_2012 - and then Nkind (Original_Node (AV)) = N_Function_Call - and then - Has_Implicit_Dereference (Etype (Name (Original_Node (AV)))) - then - - -- Check that this is not a constant reference. - - return not Is_Access_Constant (Etype (Prefix (AV))); - - elsif Has_Implicit_Dereference (Etype (Original_Node (AV))) then - return - not Is_Access_Constant (Etype - (Get_Reference_Discriminant (Etype (Original_Node (AV))))); - - else - return Is_OK_Variable_For_Out_Formal (Original_Node (AV)); - end if; + return Is_OK_Variable_For_Out_Formal (Original_Node (AV)); -- All other non-variables are rejected @@ -18792,14 +18770,14 @@ package body Sem_Util is or else Is_Variable_Prefix (Original_Node (Prefix (N))); - -- in Ada 2012, the dereference may have been added for a type with - -- a declared implicit dereference aspect. Check that it is not an - -- access to constant. + -- Generalized indexing operations are rewritten as explicit + -- dereferences, and it is only during resolution that we can + -- check whether the context requires an access_to_variable type. elsif Nkind (N) = N_Explicit_Dereference and then Present (Etype (Orig_Node)) - and then Ada_Version >= Ada_2012 and then Has_Implicit_Dereference (Etype (Orig_Node)) + and then Ada_Version >= Ada_2012 then return not Is_Access_Constant (Etype (Prefix (N))); -- 2.30.2