This aligns the handling of Ada 2012 implicit dereferences in the
Is_OK_Variable_For_Out_Formal predicate wih that in Is_Variable,
and removes unreachable code as a result.
This also makes more use of the Get_Reference_Discriminant helper
function to retrieve the reference discriminant of a type.
No functional changes.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-12 Eric Botcazou <ebotca...@adacore.com>
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
+++ 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");
--- gcc/ada/sem_ch4.adb
+++ 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
--- gcc/ada/sem_ch5.adb
+++ 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;
--- gcc/ada/sem_util.adb
+++ 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)));