Commit c2db4b32 by Arnaud Charlet

[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
parent ceb0dcaa
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
......
......@@ -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);");
......
......@@ -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 " &
......
......@@ -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));
......
......@@ -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;
......
......@@ -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
......
......@@ -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.
......
......@@ -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);
......
......@@ -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;
-----------------------------
......
......@@ -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 --
---------------------------
......
......@@ -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.
......
......@@ -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' =>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment