From 3a37ecec8934dc378bfce06d9ea2325a98159f43 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 26 May 2015 12:51:22 +0200 Subject: [PATCH] [multiple changes] 2015-05-26 Ed Schonberg * sem_ch13.adb: sem_ch13.adb (Add_Predicates): Undo analysis of original expression in ASIS mode: does not solve the ASIS problem of a usable type information, and crashes the back-end when performing type annotations. 2015-05-26 Robert Dewar * sem_disp.adb (Inherited_Subprograms): Add One_Only parameter. (Is_Overriding_Subprogram): Use One_Only_Parameter. * sem_disp.ads (Inherited_Subprograms): Add One_Only parameter. From-SVN: r223686 --- gcc/ada/ChangeLog | 13 +++++++++++++ gcc/ada/sem_ch13.adb | 7 ------- gcc/ada/sem_disp.adb | 19 ++++++++++++++----- gcc/ada/sem_disp.ads | 11 ++++++++--- 4 files changed, 35 insertions(+), 15 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c04227408fc..24fc930bbcd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2015-05-26 Ed Schonberg + + * sem_ch13.adb: sem_ch13.adb (Add_Predicates): Undo analysis + of original expression in ASIS mode: does not solve the ASIS + problem of a usable type information, and crashes the back-end + when performing type annotations. + +2015-05-26 Robert Dewar + + * sem_disp.adb (Inherited_Subprograms): Add One_Only parameter. + (Is_Overriding_Subprogram): Use One_Only_Parameter. + * sem_disp.ads (Inherited_Subprograms): Add One_Only parameter. + 2015-05-26 Robert Dewar * exp_prag.adb, sem_ch3.adb, sem_ch5.adb, exp_ch11.adb, ghost.adb, diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index d994ba3fe02..771398daca4 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -8494,13 +8494,6 @@ package body Sem_Ch13 is if Present (Asp) then - -- For ASIS use, perform semantic analysis of the original - -- predicate expression, which is otherwise not utilized. - - if ASIS_Mode then - Preanalyze_And_Resolve (Expression (Asp)); - end if; - Set_Entity (Identifier (Asp), New_Copy_Tree (Arg2)); end if; diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 1cbaef354b0..d61976e7cbe 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -2061,7 +2061,8 @@ package body Sem_Disp is function Inherited_Subprograms (S : Entity_Id; No_Interfaces : Boolean := False; - Interfaces_Only : Boolean := False) return Subprogram_List + Interfaces_Only : Boolean := False; + One_Only : Boolean := False) return Subprogram_List is Result : Subprogram_List (1 .. 6000); -- 6000 here is intended to be infinity. We could use an expandable @@ -2114,6 +2115,10 @@ package body Sem_Disp is if Is_Subprogram_Or_Generic_Subprogram (Parent_Op) then Store_IS (Parent_Op); + + if One_Only then + goto Done; + end if; end if; end loop; end if; @@ -2164,6 +2169,10 @@ package body Sem_Disp is -- We have found a primitive covered by S Store_IS (Interface_Alias (Prim)); + + if One_Only then + goto Done; + end if; end if; Next_Elmt (Elmt); @@ -2173,6 +2182,8 @@ package body Sem_Disp is end if; end if; + <> + return Result (1 .. N); end Inherited_Subprograms; @@ -2243,11 +2254,9 @@ package body Sem_Disp is -- Is_Overriding_Subprogram -- ------------------------------ - -- Seems inefficient, build a whole list of subprograms to see if it - -- is non-empty??? - function Is_Overriding_Subprogram (E : Entity_Id) return Boolean is - Inherited : constant Subprogram_List := Inherited_Subprograms (E); + Inherited : constant Subprogram_List := + Inherited_Subprograms (E, One_Only => True); begin return Inherited'Length > 0; end Is_Overriding_Subprogram; diff --git a/gcc/ada/sem_disp.ads b/gcc/ada/sem_disp.ads index d2aa620ddb7..e8cc6b72186 100644 --- a/gcc/ada/sem_disp.ads +++ b/gcc/ada/sem_disp.ads @@ -104,10 +104,11 @@ package Sem_Disp is function Inherited_Subprograms (S : Entity_Id; No_Interfaces : Boolean := False; - Interfaces_Only : Boolean := False) return Subprogram_List; + Interfaces_Only : 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 list is a - -- list of entity id's of the specs of inherited subprograms. Returns a + -- subprograms from direct inheritance or via interfaces. The result is an + -- array of Entity_Ids of the specs of inherited subprograms. Returns a -- null array if passed an Empty spec id. Note that the returned array -- only includes subprograms and generic subprograms (and excludes any -- other inherited entities, in particular enumeration literals). If @@ -117,6 +118,10 @@ package Sem_Disp is -- come first, starting with the closest ancestors, and are followed by -- subprograms inherited from interfaces. At most one of No_Interfaces -- and Interfaces_Only should be True. + -- + -- 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. function Is_Dynamically_Tagged (N : Node_Id) return Boolean; -- Used to determine whether a call is dispatching, i.e. if it is -- 2.30.2