diff options
author | Bob Duff <duff@adacore.com> | 2022-05-02 14:11:03 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2022-06-01 08:43:17 +0000 |
commit | 3c2674cc0d725783a501a78cdc1256642448c159 (patch) | |
tree | a2d0bb030119223ba9049c9e0f581efba0648235 | |
parent | c97f3a7dc230dab0877d0c27b84eb06132cf7bf8 (diff) | |
download | gcc-3c2674cc0d725783a501a78cdc1256642448c159.zip gcc-3c2674cc0d725783a501a78cdc1256642448c159.tar.gz gcc-3c2674cc0d725783a501a78cdc1256642448c159.tar.bz2 |
[Ada] Fix search for "for ... of" loop subprograms
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.
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...".
-rw-r--r-- | gcc/ada/exp_ch5.adb | 14 | ||||
-rw-r--r-- | gcc/ada/rtsfind.ads | 12 |
2 files changed, 19 insertions, 7 deletions
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 9c7a370..b995577 100644 --- 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 index 280e2bd..1270955 100644 --- 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 ( |