From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Wed, 30 Jul 2014 10:00:47 +0000 (+0200)
Subject: [multiple changes]
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=79185f5fb057480ec96ead78d386c582c579396a;p=gcc.git

[multiple changes]

2014-07-30  Robert Dewar  <dewar@adacore.com>

	* sem_util.adb (Predicate_Tests_On_Arguments): Omit tests for
	some additional cases of internally generated routines.

2014-07-30  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb (Analyze_Proper_Body): When compiling for ASIS,
	if the compilation unit is a subunit, extend optional processing
	to all subunits of the current one. This allows gnatstub to
	supress generation of spurious bodies.

From-SVN: r213236
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c3d1b62e0dd..48222031a1f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2014-07-30  Robert Dewar  <dewar@adacore.com>
+
+	* sem_util.adb (Predicate_Tests_On_Arguments): Omit tests for
+	some additional cases of internally generated routines.
+
+2014-07-30  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch10.adb (Analyze_Proper_Body): When compiling for ASIS,
+	if the compilation unit is a subunit, extend optional processing
+	to all subunits of the current one. This allows gnatstub to
+	supress generation of spurious bodies.
+
 2014-07-30  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* a-cbmutr.adb (Insert_Child): Use local variable First to keep
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index a58a8a40d18..cd110c9d185 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -1624,6 +1624,7 @@ package body Sem_Ch10 is
                Set_Corresponding_Stub (Unit (Comp_Unit), N);
                Analyze_Subunit (Comp_Unit);
                Set_Library_Unit (N, Comp_Unit);
+               Set_Corresponding_Body (N, Defining_Entity (Unit (Comp_Unit)));
             end if;
 
          elsif Unum = No_Unit
@@ -1713,15 +1714,22 @@ package body Sem_Ch10 is
       --  should be ignored, except that if we are building trees for ASIS
       --  usage we want to annotate the stub properly. If the main unit is
       --  itself a subunit, another subunit is irrelevant unless it is a
-      --  subunit of the current one.
+      --  subunit of the current one, that is to say appears in the current
+      --  source tree.
 
       elsif Nkind (Unit (Cunit (Main_Unit))) = N_Subunit
         and then Subunit_Name /= Unit_Name (Main_Unit)
       then
-         if ASIS_Mode
-           and then Scope (Defining_Entity (N)) = Cunit_Entity (Main_Unit)
-         then
-            Optional_Subunit;
+         if ASIS_Mode then
+            declare
+               PB : constant Node_Id := Proper_Body (Unit (Cunit (Main_Unit)));
+            begin
+               if Nkind_In (PB, N_Package_Body, N_Subprogram_Body)
+                 and then List_Containing (N) = Declarations (PB)
+               then
+                  Optional_Subunit;
+               end if;
+            end;
          end if;
 
          --  But before we return, set the flag for unloaded subunits. This
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 4434d5b16d5..6dc9f05a037 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -14723,32 +14723,42 @@ package body Sem_Util is
 
    function Predicate_Tests_On_Arguments (Subp : Entity_Id) return Boolean is
    begin
+      --  Always test predicates on indirect call
+
+      if Ekind (Subp) = E_Subprogram_Type then
+         return True;
+
       --  Do not test predicates on call to generated default Finalize, since
       --  we are not interested in whether something we are finalizing (and
       --  typically destroying) satisfies its predicates.
 
-      if Chars (Subp) = Name_Finalize
+      elsif Chars (Subp) = Name_Finalize
         and then not Comes_From_Source (Subp)
       then
          return False;
 
-         --  Do not test predicates on call to Init_Proc, since if needed the
-         --  predicate test will occur at some other point.
+      --  Do not test predicates on any internally generated routines
+
+      elsif Is_Internal_Name (Chars (Subp)) then
+         return False;
+
+      --  Do not test predicates on call to Init_Proc, since if needed the
+      --  predicate test will occur at some other point.
 
       elsif Is_Init_Proc (Subp) then
          return False;
 
-         --  Do not test predicates on call to predicate function, since this
-         --  would cause infinite recursion.
+      --  Do not test predicates on call to predicate function, since this
+      --  would cause infinite recursion.
 
       elsif Ekind (Subp) = E_Function
         and then (Is_Predicate_Function (Subp)
-                  or else
+                    or else
                   Is_Predicate_Function_M (Subp))
       then
          return False;
 
-         --  For now, no other exceptions
+      --  For now, no other exceptions
 
       else
          return True;