sem_disp.adb (Is_Inherited_Public_Operation): Extend the functionality of this routine to handle multiple levels of derivations.

gcc/ada/

2017-11-08  Javier Miranda  <miranda@adacore.com>

	* sem_disp.adb (Is_Inherited_Public_Operation): Extend the
	functionality of this routine to handle multiple levels of derivations.

2017-11-08  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb: Elist36 is now used as Nested_Scenarios.
	(Nested_Scenarios): New routine.
	(Set_Nested_Scenarios): New routine.
	(Write_Field36_Name): New routine.
	* einfo.ads: Add new attribute Nested_Scenarios along with occurrences
	in entities.
	(Nested_Scenarios): New routine along with pragma Inline.
	(Set_Nested_Scenarios): New routine along with pragma Inline.
	* sem_elab.adb (Find_And_Process_Nested_Scenarios): New routine.
	(Process_Nested_Scenarios): New routine.
	(Traverse_Body): When a subprogram body is traversed for the first
	time, find, save, and process all suitable scenarios found within.
	Subsequent traversals of the same subprogram body utilize the saved
	scenarios.

2017-11-08  Piotr Trojanek  <trojanek@adacore.com>

	* lib-xref-spark_specific.adb (Add_SPARK_Scope): Remove detection of
	protected operations.
	(Add_SPARK_Xrefs): Simplify detection of empty entities.
	* get_spark_xrefs.ads, get_spark_xrefs.adb, put_spark_xrefs.ads,
	put_spark_xrefs.adb, spark_xrefs_test.adb: Remove code for writing,
	reading and testing SPARK cross-references stored in the ALI files.
	* lib-xref.ads (Output_SPARK_Xrefs): Remove.
	* lib-writ.adb (Write_ALI): Do not write SPARK cross-references to the
	ALI file.
	* spark_xrefs.ads, spark_xrefs.adb (pspark): Remove, together
	with description of the SPARK xrefs ALI format.
	* gcc-interface/Make-lang.in (GNAT_ADA_OBJS): Remove get_spark_refs.o
	and put_spark_refs.o.

2017-11-08  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Apply_Accessibility_Check): Do not finalize the object
	when the associated access type is subject to pragma
	No_Heap_Finalization.
	* exp_intr.adb (Expand_Unc_Deallocation): Use the available view of the
	designated type in case it comes from a limited withed unit.

gcc/testsuite/

2017-11-08  Javier Miranda  <miranda@adacore.com>

	* gnat.dg/overriding_ops2.adb, gnat.dg/overriding_ops2.ads,
	gnat.dg/overriding_ops2_pkg.ads, gnat.dg/overriding_ops2_pkg-high.ads:
	New testcase.

From-SVN: r254532

1 files changed, 3 insertions, 18 deletions

diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb
index 4d22174..c3bad8d 100644
--- a/gcc/ada/lib-xref-spark_specific.adb
+++ b/gcc/ada/lib-xref-spark_specific.adb
@@ -139,30 +139,17 @@ package body SPARK_Specific is
          case Ekind (E) is
             when E_Entry
                | E_Entry_Family
+               | E_Function
                | E_Generic_Function
                | E_Generic_Package
                | E_Generic_Procedure
                | E_Package
+               | E_Procedure
                | E_Protected_Type
                | E_Task_Type
             =>
                Typ := Xref_Entity_Letters (Ekind (E));
 
-            when E_Function
-               | E_Procedure
-            =>
-               --  In SPARK we need to distinguish protected functions and
-               --  procedures from ordinary subprograms, but there are no
-               --  special Xref letters for them. Since this distiction is
-               --  only needed to detect protected calls, we pretend that
-               --  such calls are entry calls.
-
-               if Ekind (Scope (E)) = E_Protected_Type then
-                  Typ := Xref_Entity_Letters (E_Entry);
-               else
-                  Typ := Xref_Entity_Letters (Ekind (E));
-               end if;
-
             when E_Package_Body
                | E_Protected_Body
                | E_Subprogram_Body
@@ -670,7 +657,6 @@ package body SPARK_Specific is
       Prev_Loc   : Source_Ptr;
       Prev_Typ   : Character;
       Ref_Count  : Nat;
-      Ref_Id     : Entity_Id;
       Ref_Name   : String_Ptr;
       Scope_Id   : Scope_Index;
 
@@ -795,7 +781,6 @@ package body SPARK_Specific is
          return;
       end if;
 
-      Ref_Id     := Empty;
       Scope_Id   := 1;
       From_Index := 1;
 
@@ -833,7 +818,7 @@ package body SPARK_Specific is
                pragma Assert (Scope_Id <= SPARK_Scope_Table.Last);
             end loop;
 
-            if Ref.Ent /= Ref_Id then
+            if Present (Ref.Ent) then
                Ref_Name := new String'(Unique_Name (Ref.Ent));
             end if;