diff mbox series

[Ada] Fix search for "for ... of" loop subprograms

Message ID 20220601084454.GA1240659@adacore.com
State New
Headers show
Series [Ada] Fix search for "for ... of" loop subprograms | expand

Commit Message

Pierre-Marie de Rodat June 1, 2022, 8:44 a.m. UTC 
This patch makes the search for Get_Element_Access, Step (Next/Prev),
Reference_Control_Type, and Pseudo_Reference (for optimized "for ... of"
loops) more robust.  In particular, we have a new Next procedure in Ada
2022, and we need to pick the right one.

We have not yet added the new Next and other subprograms.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* exp_ch5.adb (Expand_Iterator_Loop_Over_Container): For each
	subprogram found, assert that the variable is Empty, so we can
	detect bugs where we find two or more things with the same name.
	Without this patch, that bug would happen when we add the new
	Next procedure.  For Step, make sure we pick the right one, by
	checking name and number of parameters.  For Get_Element_Access,
	check that we're picking a function.  That's not really
	necessary, because there is no procedure with that name, but it
	seems cleaner this way.
	* rtsfind.ads: Minor comment improvement. It seems kind of odd
	to say "under no circumstances", and then immediately contradict
	that with "The one exception is...".
diff mbox series

Patch

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -5203,22 +5203,36 @@  package body Exp_Ch5 is
 
             Ent := First_Entity (Pack);
             while Present (Ent) loop
+               --  Get_Element_Access function with one parameter called
+               --  Position.
+
                if Chars (Ent) = Name_Get_Element_Access
+                 and then Ekind (Ent) = E_Function
                  and then Present (First_Formal (Ent))
                  and then Chars (First_Formal (Ent)) = Name_Position
                  and then No (Next_Formal (First_Formal (Ent)))
                then
+                  pragma Assert (No (Fast_Element_Access_Op));
                   Fast_Element_Access_Op := Ent;
 
+               --  Next or Prev procedure with one parameter called
+               --  Position.
+
                elsif Chars (Ent) = Name_Step
                  and then Ekind (Ent) = E_Procedure
+                 and then Present (First_Formal (Ent))
+                 and then Chars (First_Formal (Ent)) = Name_Position
+                 and then No (Next_Formal (First_Formal (Ent)))
                then
+                  pragma Assert (No (Fast_Step_Op));
                   Fast_Step_Op := Ent;
 
                elsif Chars (Ent) = Name_Reference_Control_Type then
+                  pragma Assert (No (Reference_Control_Type));
                   Reference_Control_Type := Ent;
 
                elsif Chars (Ent) = Name_Pseudo_Reference then
+                  pragma Assert (No (Pseudo_Reference));
                   Pseudo_Reference := Ent;
                end if;
 


diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -540,13 +540,11 @@  package Rtsfind is
    --  value is required syntactically, but no real entry is required or
    --  needed. Use of this value will cause a fatal error in an RTE call.
 
-   --  Note that under no circumstances can any of these entities be defined
-   --  more than once in a given package, i.e. no overloading is allowed for
-   --  any entity that is found using rtsfind. A fatal error is given if this
-   --  rule is violated. The one exception is for Save_Occurrence, where the
-   --  RM mandates the overloading. In this case, the compiler only uses the
-   --  procedure, not the function, and the procedure must come first so that
-   --  the compiler finds it and not the function.
+   --  It is normally not allowed to have more than one of these entities with
+   --  the same name in a given package. The one exception is Save_Occurrence,
+   --  where the RM mandates the overloading. In this case, the compiler uses
+   --  the procedure, not the function, and the procedure must come first so
+   --  that the compiler finds it and not the function.
 
    type RE_Id is (