From: Arnaud Charlet Date: Fri, 10 Apr 2009 16:03:58 +0000 (+0200) Subject: [multiple changes] X-Git-Tag: releases/gcc-4.5.0~6676 X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=b0d3b11d8c1b75fd46510845e2b352e8a22e1e9d;p=thirdparty%2Fgcc.git [multiple changes] 2009-04-10 Robert Dewar * sem_warn.ads, sem_warn.adb (Check_Low_Bound_Tested): Catch more cases for warning suppression. 2009-04-10 Ed Schonberg * 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 * 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. From-SVN: r145926 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 69186b945897..10d2f78be8c6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2009-04-10 Robert Dewar + + * sem_warn.ads, sem_warn.adb (Check_Low_Bound_Tested): Catch more cases + for warning suppression. + +2009-04-10 Ed Schonberg + + * 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 + + * 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 * einfo.ads, einfo.adb (Low_Bound_Tested): New name for Low_Bound_Known diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 9c5eabfd9a3d..99870dc873dd 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 259908facb94..1a91bf1b0a37 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'("" & 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 52f185531d58..a912fef80b14 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 7831315ee96f..3550392f8727 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 ce97d695efd0..b375b20dd518 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