[multiple changes]

2011-08-04  Arnaud Charlet  <charlet@adacore.com>

	* prj-env.adb: Remove local debug traces.

2011-08-04  Yannick Moy  <moy@adacore.com>

	* checks.adb (Apply_Float_Conversion_Check): correct a typo where Lo_OK
	was used instead of Hi_OK, which could cause a read of an uninitialized
	value later on. Detected while working on the new warning.
	* exp_ch9.adb (Expand_N_Entry_Declaration): remove useless assignment
	to local variable.
	* sem_ch5.adb (Analyze_Assignment): set the last assignment component
	in more cases, in order to detect more unreferenced values.
	* sem_util.adb, sem_util.ads (Get_Enclosing_Object): return enclosing
	object for expression, if any.

2011-08-04  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_intr.adb (Expand_Binary_Operator_Call): Look at the RM size of
	the operand types instead of the Esize.

2011-08-04  Steve Baird  <baird@adacore.com>

	* switch-b.adb (Scan_Binder_Switches): Add -P binder switch, used to
	enable CodePeer_Mode.
	* bindusg.adb (Display): Add help message describing -P binder switch.
	* gnat_ugn.texi: Document -P binder switch.
	* bindgen.adb (Gen_Main_Ada): If CodePeer_Mode is set, then call the
	user-defined main program directly.
	(Gen_Output_File_Ada): If CodePeer_Mode is set, generate a with of the
	user-defined main program in the context clause of the package body.

From-SVN: r177355

12 files changed, 133 insertions, 19 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b947825..cd5c59c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,35 @@
+2011-08-04  Arnaud Charlet  <charlet@adacore.com>
+
+	* prj-env.adb: Remove local debug traces.
+
+2011-08-04  Yannick Moy  <moy@adacore.com>
+
+	* checks.adb (Apply_Float_Conversion_Check): correct a typo where Lo_OK
+	was used instead of Hi_OK, which could cause a read of an uninitialized
+	value later on. Detected while working on the new warning.
+	* exp_ch9.adb (Expand_N_Entry_Declaration): remove useless assignment
+	to local variable.
+	* sem_ch5.adb (Analyze_Assignment): set the last assignment component
+	in more cases, in order to detect more unreferenced values.
+	* sem_util.adb, sem_util.ads (Get_Enclosing_Object): return enclosing
+	object for expression, if any.
+
+2011-08-04  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_intr.adb (Expand_Binary_Operator_Call): Look at the RM size of
+	the operand types instead of the Esize.
+
+2011-08-04  Steve Baird  <baird@adacore.com>
+
+	* switch-b.adb (Scan_Binder_Switches): Add -P binder switch, used to
+	enable CodePeer_Mode.
+	* bindusg.adb (Display): Add help message describing -P binder switch.
+	* gnat_ugn.texi: Document -P binder switch.
+	* bindgen.adb (Gen_Main_Ada): If CodePeer_Mode is set, then call the
+	user-defined main program directly.
+	(Gen_Output_File_Ada): If CodePeer_Mode is set, generate a with of the
+	user-defined main program in the context clause of the package body.
+
 2011-08-04  Yannick Moy  <moy@adacore.com>
 
 	* alfa.adb, alfa.ads (Get_Entity_For_Decl): remove function, partial
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index a4e7cca..f13667e 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -2218,7 +2218,20 @@ package body Bindgen is
       if not No_Main_Subprogram then
          WBI ("      Break_Start;");
 
-         if ALIs.Table (ALIs.First).Main_Program = Proc then
+         if CodePeer_Mode then
+            --  Bypass Ada_Main_Program; its Import pragma confuses CodePeer.
+            Get_Name_String (Units.Table (First_Unit_Entry).Uname);
+            declare
+               Callee_Name : String renames Name_Buffer (1 .. Name_Len - 2);
+               --  strip trailing "%b"
+            begin
+               if ALIs.Table (ALIs.First).Main_Program = Proc then
+                  WBI ("      " & Callee_Name & ";");
+               else
+                  WBI ("      Result := " & Callee_Name & ";");
+               end if;
+            end;
+         elsif ALIs.Table (ALIs.First).Main_Program = Proc then
             WBI ("      Ada_Main_Program;");
          else
             WBI ("      Result := Ada_Main_Program;");
@@ -3062,6 +3075,13 @@ package body Bindgen is
          WBI ("with Ada.Exceptions;");
       end if;
 
+      if CodePeer_Mode then
+         --  For CodePeer, main program is not called via an Import pragma.
+         Get_Name_String (Units.Table (First_Unit_Entry).Uname);
+         WBI ("with " & Name_Buffer (1 .. Name_Len - 2) & ";");
+         --  strip trailing "%b"
+      end if;
+
       WBI ("");
       WBI ("package body " & Ada_Main & " is");
       WBI ("   pragma Warnings (Off);");
diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb
index 06fa354..e762c87 100644
--- a/gcc/ada/bindusg.adb
+++ b/gcc/ada/bindusg.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                B o d y                                   --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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- --
@@ -178,6 +178,10 @@ package body Bindusg is
 
       Write_Line ("  -p        Pessimistic (worst-case) elaboration order");
 
+      --  Line for -P switch
+
+      Write_Line ("  -P        Generate binder file suitable for CodePeer");
+
       --  Line for -r switch
 
       Write_Line ("  -r        List restrictions that could be applied " &
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 97bbf28..a798e3f 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -1690,7 +1690,7 @@ package body Checks is
 
       if Truncate and then Ilast < 0 then
          Hi := Succ (Expr_Type, UR_From_Uint (Ilast));
-         Lo_OK := False;
+         Hi_OK := False;
 
       elsif Truncate then
          Hi := Pred (Expr_Type, UR_From_Uint (Ilast + 1));
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index fa19383..43ec7af 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -7330,7 +7330,6 @@ package body Exp_Ch9 is
                  Subtype_Indication => New_Reference_To (Rec_Ent, Loc)));
 
          Insert_After (Last_Decl, Decl);
-         Last_Decl := Decl;
       end if;
    end Expand_N_Entry_Declaration;
 
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index 4edb9a6..39fe851 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -124,7 +124,7 @@ package body Exp_Intr is
       T3  : Entity_Id;
       Res : Node_Id;
 
-      Siz : constant Uint := UI_Max (Esize (T1), Esize (T2));
+      Siz : constant Uint := UI_Max (RM_Size (T1), RM_Size (T2));
       --  Maximum of operand sizes
 
    begin
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 76436c3..69bc275 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -8313,6 +8313,10 @@ Output object list (to standard output or to the named file).
 @cindex @option{^-p^/PESSIMISTIC_ELABORATION^} (@command{gnatbind})
 Pessimistic (worst-case) elaboration order
 
+@item ^-P^-P^
+@cindex @option{^-P^/CODEPEER^} (@command{gnatbind})
+Generate binder file suitable for CodePeer.
+
 @item ^-R^-R^
 @cindex @option{^-R^-R^} (@command{gnatbind})
 Output closure source list.
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index ff14df9..0aa907a 100644
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -534,9 +534,6 @@ package body Prj.Env is
          while Element (Iter) /= No_Source loop
             Source := Element (Iter);
 
-            Debug_Output ("MANU Source index=" & Source.Index'Img,
-                          Name_Id (Source.File));
-
             if Source.Index >= 1
               and then not Source.Locally_Removed
               and then Source.Unit /= null
@@ -703,7 +700,6 @@ package body Prj.Env is
    --  Start of processing for Create_Config_Pragmas_File
 
    begin
-      Debug_Output ("MANU Create_Config_Pragmas_File", For_Project.Name);
       if not For_Project.Config_Checked then
          Naming_Table.Init (Namings);
 
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 2716d58..3597f79 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -746,14 +746,10 @@ package body Sem_Ch5 is
             if Safe_To_Capture_Value (N, Ent) then
 
                --  If simple variable on left side, warn if this assignment
-               --  blots out another one (rendering it useless) and note
-               --  location of assignment in case no one references value. We
-               --  only do this for source assignments, otherwise we can
-               --  generate bogus warnings when an assignment is rewritten as
-               --  another assignment, and gets tied up with itself.
-
-               --  Note: we don't use Record_Last_Assignment here, because we
-               --  have lots of other stuff to do under control of this test.
+               --  blots out another one (rendering it useless). We only do
+               --  this for source assignments, otherwise we can generate bogus
+               --  warnings when an assignment is rewritten as another
+               --  assignment, and gets tied up with itself.
 
                if Warn_On_Modified_Unread
                  and then Is_Assignable (Ent)
@@ -761,7 +757,6 @@ package body Sem_Ch5 is
                  and then In_Extended_Main_Source_Unit (Ent)
                then
                   Warn_On_Useless_Assignment (Ent, N);
-                  Set_Last_Assignment (Ent, Lhs);
                end if;
 
                --  If we are assigning an access type and the left side is an
@@ -803,6 +798,28 @@ package body Sem_Ch5 is
             end if;
          end;
       end if;
+
+      --  If assigning to an object in whole or in part, note location of
+      --  assignment in case no one references value. We only do this for
+      --  source assignments, otherwise we can generate bogus warnings when an
+      --  assignment is rewritten as another assignment, and gets tied up with
+      --  itself.
+
+      declare
+         Ent : constant Entity_Id := Get_Enclosing_Object (Lhs);
+
+      begin
+         if Present (Ent)
+           and then Safe_To_Capture_Value (N, Ent)
+           and then Nkind (N) = N_Assignment_Statement
+           and then Warn_On_Modified_Unread
+           and then Is_Assignable (Ent)
+           and then Comes_From_Source (N)
+           and then In_Extended_Main_Source_Unit (Ent)
+         then
+            Set_Last_Assignment (Ent, Lhs);
+         end if;
+      end;
    end Analyze_Assignment;
 
    -----------------------------
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 6616ab8..a3e4642 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -4151,6 +4151,38 @@ package body Sem_Util is
           Strval => String_From_Name_Buffer);
    end Get_Default_External_Name;
 
+   --------------------------
+   -- Get_Enclosing_Object --
+   --------------------------
+
+   function Get_Enclosing_Object (N : Node_Id) return Entity_Id is
+   begin
+      if Is_Entity_Name (N) then
+         return Entity (N);
+      else
+         case Nkind (N) is
+            when N_Indexed_Component  |
+                 N_Slice              |
+                 N_Selected_Component =>
+
+               --  If not generating code, a dereference may be left implicit.
+               --  In thoses cases, return Empty.
+
+               if Is_Access_Type (Etype (Prefix (N))) then
+                  return Empty;
+               else
+                  return Get_Enclosing_Object (Prefix (N));
+               end if;
+
+            when N_Type_Conversion =>
+               return Get_Enclosing_Object (Expression (N));
+
+            when others =>
+               return Empty;
+         end case;
+      end if;
+   end Get_Enclosing_Object;
+
    ---------------------------
    -- Get_Enum_Lit_From_Pos --
    ---------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index a282bf6..bf57d97 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -480,6 +480,10 @@ package Sem_Util is
    --  identifier provided as the external name. Letters in the name are
    --  according to the setting of Opt.External_Name_Default_Casing.
 
+   function Get_Enclosing_Object (N : Node_Id) return Entity_Id;
+   --  If expression N references a part of an object, return this object.
+   --  Otherwise return Empty. Expression N should have been resolved already.
+
    function Get_Generic_Entity (N : Node_Id) return Entity_Id;
    --  Returns the true generic entity in an instantiation. If the name in the
    --  instantiation is a renaming, the function returns the renamed generic.
diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb
index b41296b..0d44aa8 100644
--- a/gcc/ada/switch-b.adb
+++ b/gcc/ada/switch-b.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -364,6 +364,12 @@ package body Switch.B is
             Ptr := Ptr + 1;
             Pessimistic_Elab_Order := True;
 
+         --  Processing for P switch
+
+         when 'P' =>
+            Ptr := Ptr + 1;
+            CodePeer_Mode := True;
+
          --  Processing for q switch
 
          when 'q' =>