diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 42 | ||||
| -rw-r--r-- | gcc/ada/a-except-2005.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/bindgen.adb | 64 | ||||
| -rw-r--r-- | gcc/ada/exp_ch5.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/exp_ch7.adb | 55 | ||||
| -rw-r--r-- | gcc/ada/exp_intr.adb | 34 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 23 |
9 files changed, 164 insertions, 80 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0a1c510..9cf21ed 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,45 @@ +2011-08-03 Ed Schonberg <schonberg@adacore.com> + + * exp_ch5.adb (Expand_Iterator_Loop): indicate that the cursor is + modified in the source, to prevent spurious warnings when compiling + with -gnatg. + +2011-08-03 Thomas Quinot <quinot@adacore.com> + + * a-except-2005.adb: Minor reformatting. + +2011-08-03 Ed Schonberg <schonberg@adacore.com> + + * sem_warn.adb (Check_One_Unit): if the only mention of a withed unit + is a renaming declaration in the private part of a package, do not emit + a warning that the with_clause could be moved because the renaming may + be used in the body or in a child unit. + +2011-08-03 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): + Propagate the Comes_From_Source attribute from the original return + object to the renaming. + +2011-08-03 Jose Ruiz <ruiz@adacore.com> + + * exp_ch7.adb (Build_Raise_Statement): Do not call + Raise_From_Controlled_Operation when this routine is not present in + the run-time library. + (Cleanup_Protected_Object, Cleanup_Task): For restricted run-time + libraries (Ravenscar), tasks are non-terminating, and protected objects + and tasks can only appear at library level, so we do not want + finalization of protected objects nor tasks. + * exp_intr.adb: Minor clarification in comment. + bindgen.adb (Gen_Adainit_Ada, Gen_Main_C, Gen_Output_File_Ada, + Gen_Output_File_C): Remove references to finalization of library-level + objects when using restricted run-time libraries. + +2011-08-03 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb (Build_Discriminant_Constraints): Set + Original_Discriminant only if the parent type is a generic formal. + 2011-08-03 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch13.adb: Add with and use clause for Targparm; diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index e69e859..e84b0e9 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -880,7 +880,7 @@ package body Ada.Exceptions is procedure Raise_From_Controlled_Operation (X : Ada.Exceptions.Exception_Occurrence) is - Prev_Exc : constant EOA := Get_Current_Excep.all; + Prev_Exc : constant EOA := Get_Current_Excep.all; begin -- We're raising an exception during finalization. If the finalization @@ -906,7 +906,7 @@ package body Ada.Exceptions is (Orig_Msg'First .. Orig_Msg'First + Orig_Prefix_Length - 1); begin - -- Message already has the proper prefix, just re-reraise + -- Message already has the proper prefix, just re-raise if Orig_Prefix = Prefix then Raise_Exception_No_Defer diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index eeec470..2d9a1c1 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -665,10 +665,11 @@ package body Bindgen is """__gnat_handler_installed"");"); -- The import of the soft link which performs library-level object - -- finalization is not needed for VM targets. Regular Ada is used in - -- that case. + -- finalization is not needed for VM targets; regular Ada is used in + -- that case. For restricted run-time libraries (ZFP and Ravenscar) + -- tasks are non-terminating, so we do not want finalization. - if VM_Target = No_VM then + if VM_Target = No_VM and then not Configurable_Run_Time_On_Target then WBI (""); WBI (" type No_Param_Proc is access procedure;"); WBI (" Finalize_Library_Objects : No_Param_Proc;"); @@ -926,32 +927,38 @@ package body Bindgen is WBI (" Initialize_Stack_Limit;"); end if; - -- Attach Finalize_Library to the right softlink + -- Attach Finalize_Library to the right soft link. Do it only when not + -- using a restricted run time, in which case tasks are + -- non-terminating, so we do not want library-level finalization. - if not Suppress_Standard_Library_On_Target then - WBI (""); + if not Configurable_Run_Time_On_Target then + if not Suppress_Standard_Library_On_Target then + WBI (""); - if VM_Target = No_VM then - if Lib_Final_Built then - Set_String (" Finalize_Library_Objects := "); - Set_String ("Finalize_Library'access;"); - else - Set_String (" Finalize_Library_Objects := null;"); - end if; + if VM_Target = No_VM then + if Lib_Final_Built then + Set_String (" Finalize_Library_Objects := "); + Set_String ("Finalize_Library'access;"); + else + Set_String (" Finalize_Library_Objects := null;"); + end if; - -- On VM targets use regular Ada to set the soft link + -- On VM targets use regular Ada to set the soft link - else - if Lib_Final_Built then - Set_String (" System.Soft_Links.Finalize_Library_Objects"); - Set_String (" := Finalize_Library'access;"); else - Set_String (" System.Soft_Links.Finalize_Library_Objects"); - Set_String (" := null;"); + if Lib_Final_Built then + Set_String + (" System.Soft_Links.Finalize_Library_Objects"); + Set_String (" := Finalize_Library'access;"); + else + Set_String + (" System.Soft_Links.Finalize_Library_Objects"); + Set_String (" := null;"); + end if; end if; - end if; - Write_Statement_Buffer; + Write_Statement_Buffer; + end if; end if; -- Generate elaboration calls @@ -2117,7 +2124,10 @@ package body Bindgen is ---------------- procedure Gen_Main_C is - Needs_Library_Finalization : constant Boolean := Has_Finalizer; + Needs_Library_Finalization : constant Boolean := + not Configurable_Run_Time_On_Target and then Has_Finalizer; + -- For restricted run-time libraries (ZFP and Ravenscar) tasks are + -- non-terminating, so we do not want library-level finalization. begin if Exit_Status_Supported_On_Target then @@ -2638,7 +2648,10 @@ package body Bindgen is -- Name to be used for generated Ada main program. See the body of -- function Get_Ada_Main_Name for details on the form of the name. - Needs_Library_Finalization : constant Boolean := Has_Finalizer; + Needs_Library_Finalization : constant Boolean := + not Configurable_Run_Time_On_Target and then Has_Finalizer; + -- For restricted run-time libraries (ZFP and Ravenscar) tasks are + -- non-terminating, so we do not want finalization. Bfiles : Name_Id; -- Name of generated bind file (spec) @@ -2990,7 +3003,8 @@ package body Bindgen is procedure Gen_Output_File_C (Filename : String) is - Needs_Library_Finalization : constant Boolean := Has_Finalizer; + Needs_Library_Finalization : constant Boolean := + not Configurable_Run_Time_On_Target and then Has_Finalizer; Bfile : Name_Id; pragma Warnings (Off, Bfile); diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index cba68fb..5f3e300 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3020,6 +3020,12 @@ package body Exp_Ch5 is Selector_Name => Make_Identifier (Loc, Name_Init)))); + -- The cursor is not modified in the source, but of course will + -- be updated in the generated code. Indicate that it is actually + -- set to prevent spurious warnings. + + Set_Never_Set_In_Source (Cursor, False); + -- If the range of iteration is given by a function call that -- returns a container, the finalization actions have been saved -- in the Condition_Actions of the iterator. Insert them now at diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 98b6ad0..1bb0a71 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -7787,7 +7787,10 @@ package body Exp_Ch6 is Preserve_Comes_From_Source (Object_Decl, Original_Node (Object_Decl)); - Set_Comes_From_Source (Obj_Def_Id, True); + + Preserve_Comes_From_Source + (Obj_Def_Id, Original_Node (Object_Decl)); + Set_Comes_From_Source (Renaming_Def_Id, False); end; end if; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index ad48e5a..e72c19b 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -316,7 +316,7 @@ package body Exp_Ch7 is -- Save_Occurrence (E_Id, Get_Current_Excep.all.all); -- end if; -- - -- If flag For_Library is set: + -- If flag For_Library is set (and not in restricted profile): -- -- when others => -- if not Raised_Id then @@ -769,7 +769,7 @@ package body Exp_Ch7 is Prefix => New_Reference_To (RTE (RE_Get_Current_Excep), Loc))))); - if For_Library then + if For_Library and then not Restricted_Profile then Proc_To_Call := RTE (RE_Save_Library_Occurrence); else @@ -2922,8 +2922,15 @@ package body Exp_Ch7 is Raise_Id : Entity_Id; begin - if VM_Target = No_VM then + if VM_Target /= No_VM then + Raise_Id := RTE (RE_Reraise_Occurrence); + + -- Standard run-time library + elsif RTE_Available (RE_Raise_From_Controlled_Operation) then Raise_Id := RTE (RE_Raise_From_Controlled_Operation); + + -- Restricted runtime: exception messages are not supported and hence + -- Raise_From_Controlled_Operation is not supported. else Raise_Id := RTE (RE_Reraise_Occurrence); end if; @@ -3166,12 +3173,21 @@ package body Exp_Ch7 is Loc : constant Source_Ptr := Sloc (N); begin - return - Make_Procedure_Call_Statement (Loc, - Name => - New_Reference_To (RTE (RE_Finalize_Protection), Loc), - Parameter_Associations => - New_List (Concurrent_Ref (Ref))); + -- For restricted run-time libraries (Ravenscar), tasks are + -- non-terminating, and protected objects can only appear at library + -- level, so we do not want finalization of protected objects. + + if Restricted_Profile then + return Empty; + + else + return + Make_Procedure_Call_Statement (Loc, + Name => + New_Reference_To (RTE (RE_Finalize_Protection), Loc), + Parameter_Associations => + New_List (Concurrent_Ref (Ref))); + end if; end Cleanup_Protected_Object; ------------------ @@ -3184,12 +3200,21 @@ package body Exp_Ch7 is is Loc : constant Source_Ptr := Sloc (N); begin - return - Make_Procedure_Call_Statement (Loc, - Name => - New_Reference_To (RTE (RE_Free_Task), Loc), - Parameter_Associations => - New_List (Concurrent_Ref (Ref))); + -- For restricted run-time libraries (Ravenscar), tasks are + -- non-terminating and they can only appear at library level, so we do + -- not want finalization of task objects. + + if Restricted_Profile then + return Empty; + + else + return + Make_Procedure_Call_Statement (Loc, + Name => + New_Reference_To (RTE (RE_Free_Task), Loc), + Parameter_Associations => + New_List (Concurrent_Ref (Ref))); + end if; end Cleanup_Task; ------------------------------ diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 21585ad..a08a9e3 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -31,7 +31,6 @@ with Errout; use Errout; with Exp_Atag; use Exp_Atag; with Exp_Ch4; use Exp_Ch4; with Exp_Ch7; use Exp_Ch7; -with Exp_Ch11; use Exp_Ch11; with Exp_Code; use Exp_Code; with Exp_Fixd; use Exp_Fixd; with Exp_Util; use Exp_Util; @@ -965,7 +964,6 @@ package body Exp_Intr is New_Reference_To (Standard_False, Loc)); Append_To (Stmts, Raised_Decl); - Analyze (Raised_Decl); Exc_Occ_Decl := Make_Object_Declaration (Loc, @@ -975,7 +973,6 @@ package body Exp_Intr is Set_No_Initialization (Exc_Occ_Decl); Append_To (Stmts, Exc_Occ_Decl); - Analyze (Exc_Occ_Decl); Final_Code := New_List ( Make_Block_Statement (Loc, @@ -1034,21 +1031,7 @@ package body Exp_Intr is At_End_Proc => New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc))); - -- We now expand the exception (at end) handler. We set a - -- temporary parent pointer since we have not attached Blk - -- to the tree yet. - - Set_Parent (Blk, N); - Analyze (Blk); - Expand_At_End_Handler - (Handled_Statement_Sequence (Blk), Entity (Identifier (Blk))); Append (Blk, Stmts); - - -- We kill saved current values, since analyzing statements not - -- properly attached to the tree can set wrong current values. - - Kill_Current_Values; - else Append_List_To (Stmts, Final_Code); end if; @@ -1129,7 +1112,7 @@ package body Exp_Intr is Append_To (Stmts, Free_Node); Set_Storage_Pool (Free_Node, Pool); - -- Attach to tree before analysis of generated subtypes below. + -- Attach to tree before analysis of generated subtypes below Set_Parent (Stmts, Parent (N)); @@ -1142,17 +1125,15 @@ package body Exp_Intr is if Is_RTE (Pool, RE_SS_Pool) then null; - elsif Is_Class_Wide_Type (Etype (Pool)) then + -- Case of a class-wide pool type: make a dispatching call to + -- Deallocate through the class-wide Deallocate_Any. - -- Case of a class-wide pool type: make a dispatching call - -- to Deallocate through the class-wide Deallocate_Any. + elsif Is_Class_Wide_Type (Etype (Pool)) then + Set_Procedure_To_Call (Free_Node, RTE (RE_Deallocate_Any)); - Set_Procedure_To_Call (Free_Node, - RTE (RE_Deallocate_Any)); + -- Case of a specific pool type: make a statically bound call else - -- Case of a specific pool type: make a statically bound call - Set_Procedure_To_Call (Free_Node, Find_Prim_Op (Etype (Pool), Name_Deallocate)); end if; @@ -1261,7 +1242,8 @@ package body Exp_Intr is -- -- Generate: -- if Raised then - -- Reraise_Occurrence (Exc_Occ); -- for .NET + -- Reraise_Occurrence (Exc_Occ); -- for .NET and + -- -- restricted RTS -- <or> -- Raise_From_Controlled_Operation (Exc_Occ); -- all other cases -- end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 42303e7..1851f93 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -8354,14 +8354,11 @@ package body Sem_Ch3 is Error_Msg_N ("& does not match any discriminant", Id); return New_Elmt_List; - -- The following is only useful for the benefit of generic - -- instances but it does not interfere with other - -- processing for the non-generic case so we do it in all - -- cases (for generics this statement is executed when - -- processing the generic definition, see comment at the - -- beginning of this if statement). + -- If the parent type is a generic formal, preserve the + -- name of the discriminant for subsequent instances. + -- see comment at the beginning of this if statement. - else + elsif Is_Generic_Type (Root_Type (T)) then Set_Original_Discriminant (Id, Discr); end if; end if; diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index fdd32ba..6b9dd9b 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -2425,9 +2425,19 @@ package body Sem_Warn is Pack := Find_Package_Renaming (Spec_Entity (Munite), Lunit); + else + Pack := Empty; end if; - if Unreferenced_In_Spec (Item) then + -- If a renaming is present in the spec do not warn + -- because the body or child unit may depend on it. + + if Present (Pack) + and then Renamed_Entity (Pack) = Lunit + then + exit; + + elsif Unreferenced_In_Spec (Item) then Error_Msg_N -- CODEFIX ("?unit& is not referenced in spec!", Name (Item)); @@ -3367,10 +3377,15 @@ package body Sem_Warn is Error_Msg_FE ("`IN OUT` prefix overlaps with actual for&?", Act1, Form); + else + + -- For greater clarity, give name of formal. + + Error_Msg_Node_2 := Form; Error_Msg_FE - ("writable actual overlaps with actual for&?", - Act1, Form); + ("writable actual for & overlaps with" + & " actual for&?", Act1, Form); end if; else |