OSDN Git Service

2009-11-30 Matthew Heaney <heaney@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 16:08:37 +0000 (16:08 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 16:08:37 +0000 (16:08 +0000)
* 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.

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

gcc/ada/ChangeLog
gcc/ada/a-coinve.adb
gcc/ada/a-tiinio.adb
gcc/ada/a-wtinio.adb
gcc/ada/a-ztinio.adb
gcc/ada/exp_util.adb
gcc/ada/freeze.adb
gcc/ada/make.adb
gcc/ada/sem_util.adb
gcc/ada/sem_warn.adb
gcc/ada/usage.adb

index 3a3bad1..8152f3d 100644 (file)
@@ -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
index 9169e08..84ad22e 100644 (file)
@@ -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;
 
index 4a4eb52..eb2aa32 100644 (file)
@@ -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 --
index 78f4bb8..507145f 100644 (file)
@@ -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
index ff36c4f..93e4d28 100644 (file)
@@ -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
index bd1748b..564c11b 100644 (file)
@@ -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
index e081002..7f0f786 100644 (file)
@@ -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;
 
index 252be1b..0e3c857 100644 (file)
@@ -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,
index a73d346..e56066b 100644 (file)
@@ -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
index abfdf1f..580ba9a 100644 (file)
@@ -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;
index 9df7c47..8b0d0cb 100644 (file)
@@ -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");