diff options
| -rw-r--r-- | gcc/ada/sem_disp.adb | 30 | ||||
| -rw-r--r-- | gcc/ada/sem_disp.ads | 5 |
2 files changed, 35 insertions, 0 deletions
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 6c8212c..b22407aa 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -2530,6 +2530,7 @@ package body Sem_Disp is (S : Entity_Id; No_Interfaces : Boolean := False; Interfaces_Only : Boolean := False; + Skip_Overridden : Boolean := False; One_Only : Boolean := False) return Subprogram_List is Result : Subprogram_List (1 .. 6000); @@ -2670,6 +2671,34 @@ package body Sem_Disp is end if; end if; + -- Do not keep an overridden operation if its overridding operation + -- is in the results too, and it is not S. This can happen for + -- inheritance between interfaces. + + if Skip_Overridden then + declare + Res : constant Subprogram_List (1 .. N) := Result (1 .. N); + M : Nat := 0; + begin + for J in 1 .. N loop + for K in 1 .. N loop + if Res (K) /= S + and then Res (J) = Overridden_Operation (Res (K)) + then + goto Skip; + end if; + end loop; + + M := M + 1; + Result (M) := Res (J); + + <<Skip>> + end loop; + + N := M; + end; + end if; + <<Done>> return Result (1 .. N); @@ -2702,6 +2731,7 @@ package body Sem_Disp is (S : Entity_Id; No_Interfaces : Boolean := False; Interfaces_Only : Boolean := False; + Skip_Overridden : Boolean := False; One_Only : Boolean := False) return Subprogram_List renames Inheritance_Utilities_Inst.Inherited_Subprograms; diff --git a/gcc/ada/sem_disp.ads b/gcc/ada/sem_disp.ads index 1e6c9e6..a2cfec8 100644 --- a/gcc/ada/sem_disp.ads +++ b/gcc/ada/sem_disp.ads @@ -120,6 +120,7 @@ package Sem_Disp is (S : Entity_Id; No_Interfaces : Boolean := False; Interfaces_Only : Boolean := False; + Skip_Overridden : Boolean := False; One_Only : Boolean := False) return Subprogram_List; function Is_Overriding_Subprogram (E : Entity_Id) return Boolean; @@ -129,6 +130,7 @@ package Sem_Disp is (S : Entity_Id; No_Interfaces : Boolean := False; Interfaces_Only : Boolean := False; + Skip_Overridden : Boolean := False; One_Only : Boolean := False) return Subprogram_List; -- Given the spec of a subprogram, this function gathers any inherited -- subprograms from direct inheritance or via interfaces. The result is an @@ -143,6 +145,9 @@ package Sem_Disp is -- subprograms inherited from interfaces. At most one of No_Interfaces -- and Interfaces_Only should be True. -- + -- If Skip_Overridden is True, subprograms overridden by another subprogram + -- in the result list are skipped. + -- -- If One_Only is set, the search is discontinued as soon as one entry -- is found. In this case the resulting array is either null or contains -- exactly one element. |