diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 34 | ||||
| -rw-r--r-- | gcc/ada/a-coinve.adb | 45 | ||||
| -rw-r--r-- | gcc/ada/a-tiinio.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/a-wtinio.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/a-ztinio.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 40 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/usage.adb | 13 |
11 files changed, 163 insertions, 38 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3a3bad104ab..8152f3d5dc2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2009-11-30 Matthew Heaney <heaney@adacore.com> + + * a-coinve.adb (Insert): Move exception handler closer to point where + exception can occur. + Minor reformatting & comment additions. + +2009-11-30 Arnaud Charlet <charlet@adacore.com> + + * freeze.adb (Freeze_Entity): Disable warning on 'Foreign caller must + pass bounds' for VM targets, not relevant. + +2009-11-30 Robert Dewar <dewar@adacore.com> + + * sem_util.adb (Wrong_Type): Diagnose additional case of modular + missing parens. + * a-tiinio.adb, a-wtinio.adb, a-ztinio.adb: Minor reformatting + + * exp_util.adb (Kill_Dead_Code): Suppress warning for some additional + cases. + + * sem_warn.adb (Set_Warning_Flag): Clean up gnatwA list and ensure + completeness. + (Set_Dot_Warning_Flag): Ditto for -gnatw.e + (Set_Dot_Warning_Flag): Implement -gnbatw.v/w.V + * usage.adb: Add lines for -gnatw.v/w.V + +2009-11-30 Emmanuel Briot <briot@adacore.com> + + * make.adb (Check_Standard_Library): use Full_Source_Name instead of + direct call to Find_File. The former provides caching of the results, so + might be more efficient + (Start_Compile_If_Necessary): Add comment on possible optimization, + not done for now. + 2009-11-30 Thomas Quinot <quinot@adacore.com> * g-sechas.adb: Minor reformatting diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index 9169e086ebd..84ad22ec1f9 100644 --- a/gcc/ada/a-coinve.adb +++ b/gcc/ada/a-coinve.adb @@ -1121,21 +1121,45 @@ package body Ada.Containers.Indefinite_Vectors is Index : constant Index_Type := Index_Type (Index_As_Int); - J : Index_Type'Base := Before; + J : Index_Type'Base; begin + -- The new items are being inserted in the middle of the + -- array, in the range [Before, Index). Copy the existing + -- elements to the end of the array, to make room for the + -- new items. + E (Index .. New_Last) := E (Before .. Container.Last); Container.Last := New_Last; - while J < Index loop - E (J) := new Element_Type'(New_Item); - J := J + 1; - end loop; + -- We have copied the existing items up to the end of the + -- array, to make room for the new items in the middle of + -- the array. Now we actually allocate the new items. - exception - when others => - E (J .. Index - 1) := (others => null); - raise; + -- Note: initialize J outside loop to make it clear that + -- J always has a value if the exception handler triggers. + + J := Before; + begin + while J < Index loop + E (J) := new Element_Type'(New_Item); + J := J + 1; + end loop; + + exception + when others => + + -- Values in the range [Before, J) were successfully + -- allocated, but values in the range [J, Index) are + -- stale (these array positions contain copies of the + -- old items, that did not get assigned a new item, + -- because the allocation failed). We must finish what + -- we started by clearing out all of the stale values, + -- leaving a "hole" in the middle of the array. + + E (J .. Index - 1) := (others => null); + raise; + end; end; else @@ -1149,6 +1173,9 @@ package body Ada.Containers.Indefinite_Vectors is return; end if; + -- There follows LOTS of code completely devoid of comments ??? + -- This is not our general style ??? + declare C, CC : UInt; diff --git a/gcc/ada/a-tiinio.adb b/gcc/ada/a-tiinio.adb index 4a4eb520f91..eb2aa327be2 100644 --- a/gcc/ada/a-tiinio.adb +++ b/gcc/ada/a-tiinio.adb @@ -36,11 +36,11 @@ package body Ada.Text_IO.Integer_IO is package Aux renames Ada.Text_IO.Integer_Aux; Need_LLI : constant Boolean := Num'Base'Size > Integer'Size; - -- Throughout this generic body, we distinguish between the case - -- where type Integer is acceptable, and where a Long_Long_Integer - -- is needed. This constant Boolean is used to test for these cases - -- and since it is a constant, only the code for the relevant case - -- will be included in the instance. + pragma Warnings (Off, Need_LLI); + -- Throughout this generic body, we distinguish between the case where type + -- Integer is acceptable, and where a Long_Long_Integer is needed. This + -- Boolean is used to test for these cases and since it is a constant, only + -- code for the relevant case will be included in the instance. --------- -- Get -- diff --git a/gcc/ada/a-wtinio.adb b/gcc/ada/a-wtinio.adb index 78f4bb8f3bb..507145f98e7 100644 --- a/gcc/ada/a-wtinio.adb +++ b/gcc/ada/a-wtinio.adb @@ -36,11 +36,10 @@ with System.WCh_WtS; use System.WCh_WtS; package body Ada.Wide_Text_IO.Integer_IO is Need_LLI : constant Boolean := Num'Base'Size > Integer'Size; - -- Throughout this generic body, we distinguish between the case - -- where type Integer is acceptable, and where a Long_Long_Integer - -- is needed. This constant Boolean is used to test for these cases - -- and since it is a constant, only the code for the relevant case - -- will be included in the instance. + -- Throughout this generic body, we distinguish between the case where type + -- Integer is acceptable, and where a Long_Long_Integer is needed. This + -- Boolean is used to test for these cases and since it is a constant, only + -- code for the relevant case will be included in the instance. subtype TFT is Ada.Wide_Text_IO.File_Type; -- File type required for calls to routines in Aux diff --git a/gcc/ada/a-ztinio.adb b/gcc/ada/a-ztinio.adb index ff36c4fd1a5..93e4d280960 100644 --- a/gcc/ada/a-ztinio.adb +++ b/gcc/ada/a-ztinio.adb @@ -36,11 +36,10 @@ with System.WCh_WtS; use System.WCh_WtS; package body Ada.Wide_Wide_Text_IO.Integer_IO is Need_LLI : constant Boolean := Num'Base'Size > Integer'Size; - -- Throughout this generic body, we distinguish between the case - -- where type Integer is acceptable, and where a Long_Long_Integer - -- is needed. This constant Boolean is used to test for these cases - -- and since it is a constant, only the code for the relevant case - -- will be included in the instance. + -- Throughout this generic body, we distinguish between the case where type + -- Integer is acceptable, and where a Long_Long_Integer is needed. This + -- Boolean is used to test for these cases and since it is a constant, only + -- code for the relevant case will be included in the instance. subtype TFT is Ada.Wide_Wide_Text_IO.File_Type; -- File type required for calls to routines in Aux diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index bd1748b1de2..564c11b6613 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -3412,17 +3412,49 @@ package body Exp_Util is -------------------- procedure Kill_Dead_Code (N : Node_Id; Warn : Boolean := False) is + W : Boolean := Warn; + -- Set False if warnings suppressed + begin if Present (N) then Remove_Warning_Messages (N); - if Warn then - Error_Msg_F - ("?this code can never be executed and has been deleted!", N); + -- Generate warning if appropriate + + if W then + + -- We suppress the warning if this code is under control of an + -- if statement, whose condition is a simple identifier, and + -- either we are in an instance, or warnings off is set for this + -- identifier. The reason for killing it in the instance case is + -- that it is common and reasonable for code to be deleted in + -- instances for various reasons. + + if Nkind (Parent (N)) = N_If_Statement then + declare + C : constant Node_Id := Condition (Parent (N)); + begin + if Nkind (C) = N_Identifier + and then + (In_Instance + or else (Present (Entity (C)) + and then Has_Warnings_Off (Entity (C)))) + then + W := False; + end if; + end; + end if; + + -- Generate warning if not suppressed + + if W then + Error_Msg_F + ("?this code can never be executed and has been deleted!", N); + end if; end if; -- Recurse into block statements and bodies to process declarations - -- and statements + -- and statements. if Nkind (N) = N_Block_Statement or else Nkind (N) = N_Subprogram_Body diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index e0810029314..7f0f7863824 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -2602,6 +2602,11 @@ package body Freeze is and then Is_Array_Type (F_Type) and then not Is_Constrained (F_Type) and then Warn_On_Export_Import + + -- Exclude VM case, since both .NET and JVM can handle + -- unconstrained arrays without a problem. + + and then VM_Target = No_VM then Error_Msg_Qual_Level := 1; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 252be1be04f..0e3c85765d5 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -2678,8 +2678,7 @@ package body Make is -- library only if we can find it. if RTS_Switch then - Add_It := - Find_File (Sfile, Osint.Source) /= No_File; + Add_It := Full_Source_Name (Sfile) /= No_File; end if; if Add_It then @@ -3247,6 +3246,13 @@ package body Make is Attr => Source_File_Attr'Access); Lib_File := Osint.Lib_File_Name (Source_File, Source_Index); + + -- ??? This call could be avoided when using projects, since we + -- know where the ALI file is supposed to be. That would avoid + -- searches in the object directories, including in the runtime + -- dir. However, that would require getting access to the + -- Source_Id. + Osint.Full_Lib_File_Name (Lib_File, Lib_File => Full_Lib_File, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index a73d346084a..e56066b7d4d 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -11380,7 +11380,15 @@ package body Sem_Util is L : constant Node_Id := Left_Opnd (Op); R : constant Node_Id := Right_Opnd (Op); begin - if Etype (L) = Found_Type + -- The case for the message is when the left operand of the + -- comparison is the same modular type, or when it is an + -- integer literal (or other universal integer expression), + -- which would have been typed as the modular type if the + -- parens had been there. + + if (Etype (L) = Found_Type + or else + Etype (L) = Universal_Integer) and then Is_Integer_Type (Etype (R)) then Error_Msg_N diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index abfdf1ff668..580ba9aedc0 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -2992,8 +2992,10 @@ package body Sem_Warn is Warn_On_Object_Renames_Function := True; Warn_On_Obsolescent_Feature := True; Warn_On_Overlap := True; + Warn_On_Parameter_Order := True; Warn_On_Questionable_Missing_Parens := True; Warn_On_Redundant_Constructs := True; + Warn_On_Reverse_Bit_Order := True; Warn_On_Unchecked_Conversion := True; Warn_On_Unrecognized_Pragma := True; Warn_On_Unrepped_Components := True; @@ -3032,6 +3034,12 @@ package body Sem_Warn is when 'R' => Warn_On_Object_Renames_Function := False; + when 'v' => + Warn_On_Reverse_Bit_Order := True; + + when 'V' => + Warn_On_Reverse_Bit_Order := False; + when 'w' => Warn_On_Warnings_Off := True; @@ -3084,6 +3092,7 @@ package body Sem_Warn is Warn_On_Obsolescent_Feature := True; Warn_On_Questionable_Missing_Parens := True; Warn_On_Redundant_Constructs := True; + Warn_On_Reverse_Bit_Order := False; Warn_On_Object_Renames_Function := True; Warn_On_Unchecked_Conversion := True; Warn_On_Unrecognized_Pragma := True; @@ -3120,11 +3129,13 @@ package body Sem_Warn is Warn_On_Parameter_Order := True; Warn_On_Questionable_Missing_Parens := True; Warn_On_Redundant_Constructs := True; + Warn_On_Reverse_Bit_Order := True; Warn_On_Unchecked_Conversion := True; Warn_On_Unrecognized_Pragma := True; Warn_On_Unrepped_Components := True; when 'A' => + Address_Clause_Overlay_Warnings := False; Check_Unreferenced := False; Check_Unreferenced_Formals := False; Check_Withs := False; @@ -3133,6 +3144,7 @@ package body Sem_Warn is Implementation_Unit_Warnings := False; Ineffective_Inline_Warnings := False; Warn_On_Ada_2005_Compatibility := False; + Warn_On_All_Unread_Out_Parameters := False; Warn_On_Assertion_Failure := False; Warn_On_Assumed_Low_Bound := False; Warn_On_Bad_Fixed_Value := False; @@ -3145,13 +3157,13 @@ package body Sem_Warn is Warn_On_Modified_Unread := False; Warn_On_No_Value_Assigned := False; Warn_On_Non_Local_Exception := False; + Warn_On_Object_Renames_Function := False; Warn_On_Obsolescent_Feature := False; Warn_On_Overlap := False; - Warn_On_All_Unread_Out_Parameters := False; Warn_On_Parameter_Order := False; Warn_On_Questionable_Missing_Parens := False; Warn_On_Redundant_Constructs := False; - Warn_On_Object_Renames_Function := False; + Warn_On_Reverse_Bit_Order := False; Warn_On_Unchecked_Conversion := False; Warn_On_Unrecognized_Pragma := False; Warn_On_Unrepped_Components := False; diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 9df7c47f1ac..8b0d0cba4e3 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -397,9 +397,9 @@ begin Write_Switch_Char ("wxx"); Write_Line ("Enable selected warning modes, xx = list of parameters:"); - Write_Line (" a turn on all optional warnings " & + Write_Line (" a turn on all optional info/warnings " & "(except dhl.ot.w)"); - Write_Line (" A turn off all optional warnings"); + Write_Line (" A turn off all optional info/warnings"); Write_Line (" .a* turn on warnings for failing assertion"); Write_Line (" .A turn off warnings for failing assertion"); Write_Line (" b turn on warnings for bad fixed value " & @@ -414,8 +414,9 @@ begin Write_Line (" .C* turn off warnings for unrepped components"); Write_Line (" d turn on warnings for implicit dereference"); Write_Line (" D* turn off warnings for implicit dereference"); - Write_Line (" e treat all warnings as errors"); - Write_Line (" .e turn on every optional warning (no exceptions)"); + Write_Line (" e treat all warnings (but not info) as errors"); + Write_Line (" .e turn on every optional info/warning " & + "(no exceptions)"); Write_Line (" f turn on warnings for unreferenced formal"); Write_Line (" F* turn off warnings for unreferenced formal"); Write_Line (" g* turn on warnings for unrecognized pragma"); @@ -465,13 +466,15 @@ begin Write_Line (" R* turn off warnings for redundant construct"); Write_Line (" .r turn on warnings for object renaming function"); Write_Line (" .R* turn off warnings for object renaming function"); - Write_Line (" s suppress all warnings"); + Write_Line (" s suppress all info/warnings"); Write_Line (" t turn on warnings for tracking deleted code"); Write_Line (" T* turn off warnings for tracking deleted code"); Write_Line (" u turn on warnings for unused entity"); Write_Line (" U* turn off warnings for unused entity"); Write_Line (" v* turn on warnings for unassigned variable"); Write_Line (" V turn off warnings for unassigned variable"); + Write_Line (" .v* turn on info messages for reverse bit order"); + Write_Line (" .V turn off info messages for reverse bit order"); Write_Line (" w* turn on warnings for wrong low bound assumption"); Write_Line (" W turn off warnings for wrong low bound " & "assumption"); |
