2009-04-10 Robert Dewar <dewar@adacore.com>

	* sem_warn.ads, sem_warn.adb (Check_Low_Bound_Tested): Catch more cases
	for warning suppression.

2009-04-10  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Use_One_Type): If the two use_type clauses are
	identical, there is no redudancy to check.

2009-04-10  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch5.adb (Expand_N_Extended_Return_Statement): Delete redundant
	calls initializing SS_Allocator (which is initialized in following
	code).
	(Expand_Simple_Function_Return): Add comment about False value for
	Comes_From_Source on secondary-stack allocator.

	* exp_ch9.adb (Build_Entry_Family_Name): Add comment.
	(Build_Entry_Name): Add comment.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@145926 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 62 insertions, 12 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 69186b94589..10d2f78be8c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,26 @@
 2009-04-10  Robert Dewar  <dewar@adacore.com>
 
+	* sem_warn.ads, sem_warn.adb (Check_Low_Bound_Tested): Catch more cases
+	for warning suppression.
+
+2009-04-10  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Use_One_Type): If the two use_type clauses are
+	identical, there is no redudancy to check.
+
+2009-04-10  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_ch5.adb (Expand_N_Extended_Return_Statement): Delete redundant
+	calls initializing SS_Allocator (which is initialized in following
+	code).
+	(Expand_Simple_Function_Return): Add comment about False value for
+	Comes_From_Source on secondary-stack allocator.
+
+	* exp_ch9.adb (Build_Entry_Family_Name): Add comment.
+	(Build_Entry_Name): Add comment.
+
+2009-04-10  Robert Dewar  <dewar@adacore.com>
+
 	* einfo.ads, einfo.adb (Low_Bound_Tested): New name for Low_Bound_Known
 
 	* sem_prag.adb (Analyze_Pragma, case Check): Remove check for lower
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 9c5eabfd9a3..99870dc873d 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -2814,8 +2814,6 @@ package body Exp_Ch5 is
                                 Expression =>
                                   New_Copy_Tree (Return_Obj_Expr)));
 
-                        SS_Allocator := New_Copy_Tree (Heap_Allocator);
-
                      else
                         --  If the function returns a class-wide type we cannot
                         --  use the return type for the allocator. Instead we
@@ -2841,19 +2839,20 @@ package body Exp_Ch5 is
                         --  then the object will be default initialized twice.
 
                         Set_No_Initialization (Heap_Allocator);
-
-                        SS_Allocator := New_Copy_Tree (Heap_Allocator);
                      end if;
 
                      --  If the No_Allocators restriction is active, then only
                      --  an allocator for secondary stack allocation is needed.
+                     --  It's OK for such allocators to have Comes_From_Source
+                     --  set to False, because gigi knows not to flag them as
+                     --  being a violation of No_Implicit_Heap_Allocations.
 
                      if Restriction_Active (No_Allocators) then
                         SS_Allocator   := Heap_Allocator;
                         Heap_Allocator := Make_Null (Loc);
 
-                     --  Otherwise the heap allocator may be needed, so we
-                     --  make another allocator for secondary stack allocation.
+                     --  Otherwise the heap allocator may be needed, so we make
+                     --  another allocator for secondary stack allocation.
 
                      else
                         SS_Allocator := New_Copy_Tree (Heap_Allocator);
@@ -2863,7 +2862,7 @@ package body Exp_Ch5 is
                         --  allocator (that is, it will only be executed on
                         --  behalf of callers that call the function as
                         --  initialization for such an allocator). This
-                        --  prevents errors when No_Implicit_Heap_Allocation
+                        --  prevents errors when No_Implicit_Heap_Allocations
                         --  is in force.
 
                         Set_Comes_From_Source (Heap_Allocator, True);
@@ -3925,6 +3924,10 @@ package body Exp_Ch5 is
 
                Set_Associated_Storage_Pool (Acc_Typ, RTE (RE_SS_Pool));
 
+               --  This is an allocator for the secondary stack, and it's fine
+               --  to have Comes_From_Source set False on it, as gigi knows not
+               --  to flag it as a violation of No_Implicit_Heap_Allocations.
+
                Alloc_Node :=
                  Make_Allocator (Loc,
                    Expression =>
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 259908facb9..1a91bf1b0a3 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -1221,6 +1221,10 @@ package body Exp_Ch9 is
          --  Generate:
          --    new String'("<Entry name>" & Lnn'Img);
 
+         --  This is an implicit heap allocation, and Comes_From_Source is
+         --  False, which ensures that it will get flagged as a violation of
+         --  No_Implicit_Heap_Allocations when that restriction applies.
+
          Val :=
            Make_Allocator (Loc,
              Make_Qualified_Expression (Loc,
@@ -1268,6 +1272,11 @@ package body Exp_Ch9 is
 
       begin
          Get_Name_String (Chars (Id));
+
+         --  This is an implicit heap allocation, and Comes_From_Source is
+         --  False, which ensures that it will get flagged as a violation of
+         --  No_Implicit_Heap_Allocations when that restriction applies.
+
          Val :=
            Make_Allocator (Loc,
              Make_Qualified_Expression (Loc,
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 52f185531d5..a912fef80b1 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -7219,6 +7219,15 @@ package body Sem_Ch8 is
                        and then
                      Nkind (Parent (Clause2)) = N_Compilation_Unit
                   then
+
+                     --  If the unit is a subprogram body that acts as spec,
+                     --  the context clause is shared with the constructed
+                     --  subprogram spec. Clearly there is no redundancy.
+
+                     if Clause1 = Clause2 then
+                        return;
+                     end if;
+
                      Unit1 := Unit (Parent (Clause1));
                      Unit2 := Unit (Parent (Clause2));
 
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 7831315ee96..3550392f872 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -619,10 +619,17 @@ package body Sem_Warn is
               and then Attribute_Name (L) = Name_First
               and then Is_Entity_Name (Prefix (L))
               and then Is_Formal (Entity (Prefix (L)))
-              and then Nkind (R) = N_Integer_Literal
             then
                Set_Low_Bound_Tested (Entity (Prefix (L)));
             end if;
+
+            if Nkind (R) = N_Attribute_Reference
+              and then Attribute_Name (R) = Name_First
+              and then Is_Entity_Name (Prefix (R))
+              and then Is_Formal (Entity (Prefix (R)))
+            then
+               Set_Low_Bound_Tested (Entity (Prefix (R)));
+            end if;
          end;
       end if;
    end Check_Low_Bound_Tested;
diff --git a/gcc/ada/sem_warn.ads b/gcc/ada/sem_warn.ads
index ce97d695efd..b375b20dd51 100644
--- a/gcc/ada/sem_warn.ads
+++ b/gcc/ada/sem_warn.ads
@@ -170,10 +170,11 @@ package Sem_Warn is
 
    procedure Check_Low_Bound_Tested (Expr : Node_Id);
    --  Expr is the node for a comparison operation. This procedure checks if
-   --  the comparison is a source comparison of P'First with a literal and if
-   --  so, sets the Low_Bound_Tested flag in Expr to suppress warnings about
-   --  improper low bound assumptions (we assume that if the code explicitly
-   --  checks X'First, then it is not operating in blind assumption mode).
+   --  the comparison is a source comparison of P'First with some other value
+   --  and if so, sets the Low_Bound_Tested flag in Expr to suppress warnings
+   --  about improper low bound assumptions (we assume that if the code has a
+   --  test that explicitly checks X'First, then it is not operating in blind
+   --  assumption mode).
 
    procedure Warn_On_Known_Condition (C : Node_Id);
    --  C is a node for a boolean expression resulting from a relational