[multiple changes]

2015-05-26  Ed Schonberg  <schonberg@adacore.com>

	* 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  <dewar@adacore.com>

	* 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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c042274..24fc930 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2015-05-26  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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  <dewar@adacore.com>
+
+       * 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  <dewar@adacore.com>
 
        * 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 d994ba3..771398d 100644 (file)
--- 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 1cbaef3..d61976e 100644 (file)
--- 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;
 
+      <<Done>>
+
       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 d2aa620..e8cc6b7 100644 (file)
--- 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