OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2009-07-27  Robert Dewar  <dewar@adacore.com>

	* exp_ch6.adb (Expand_Call): Reset Is_Known_Valid after call

	* sem_ch3.adb, sem_eval.adb, sem_aux.adb: Minor comment reformatting

2009-07-27  Geert Bosch  <bosch@adacore.com>

	* checks.adb (Find_Check): Minor streamlining of logic.
	* gnat1drv.adb(Gnat1drv): Put Check_Rep_Info in its alphabetical order.
	* debug.adb: Document -gnatdX debug flag
	* exp_ch2.adb(Expand_Entity_Reference): Implement new -gnatdX flag to
	list information about reads from scalar entities.
	Also slightly simplify condition for Expand_Current_Value.
	* sem_util.ads, sem_util.adb (Is_LHS, Is_Actual_Out_Parameter): New
	functions.

From-SVN: r150110
This commit is contained in:
Arnaud Charlet 2009-07-27 15:20:37 +02:00
parent b1c44a93c7
commit 75ba322d4b
11 changed files with 114 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,4 +1,21 @@
2009-07-16 Dave Korn <dave.korn.cygwin@gmail.com>
2009-07-27 Robert Dewar <dewar@adacore.com>
* exp_ch6.adb (Expand_Call): Reset Is_Known_Valid after call
* sem_ch3.adb, sem_eval.adb, sem_aux.adb: Minor comment reformatting
2009-07-27 Geert Bosch <bosch@adacore.com>
* checks.adb (Find_Check): Minor streamlining of logic.
* gnat1drv.adb(Gnat1drv): Put Check_Rep_Info in its alphabetical order.
* debug.adb: Document -gnatdX debug flag
* exp_ch2.adb(Expand_Entity_Reference): Implement new -gnatdX flag to
list information about reads from scalar entities.
Also slightly simplify condition for Expand_Current_Value.
* sem_util.ads, sem_util.adb (Is_LHS, Is_Actual_Out_Parameter): New
functions.
2009-07-26 Dave Korn <dave.korn.cygwin@gmail.com>
PR bootstrap/40578
* adaint.h (FOPEN, STAT, FSTAT, LSTAT, STRUCT_STAT): Rename from these

3
gcc/ada/checks.adb
View File

@ -4254,7 +4254,7 @@ package body Checks is
-- Start of processing for Find_Check
begin
-- Establish default, to avoid warnings from GCC
-- Establish default, in case no entry is found
Check_Num := 0;
@ -4325,7 +4325,6 @@ package body Checks is
-- If we fall through entry was not found
Check_Num := 0;
return;
end Find_Check;

2
gcc/ada/debug.adb
View File

@ -87,7 +87,7 @@ package body Debug is
-- dU Enable garbage collection of unreachable entities
-- dV Enable viewing of all symbols in debugger
-- dW Disable warnings on calls for IN OUT parameters
-- dX
-- dX Display messages on reads of potentially uninitialized scalars
-- dY Enable configurable run-time mode
-- dZ Generate listing showing the contents of the dispatch tables

32
gcc/ada/exp_ch2.adb
View File

@ -24,6 +24,7 @@
------------------------------------------------------------------------------
with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
@ -34,12 +35,14 @@ with Exp_VFpt; use Exp_VFpt;
with Namet; use Namet;
with Nmake; use Nmake;
with Opt; use Opt;
with Output; use Output;
with Sem; use Sem;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
with Sem_Warn; use Sem_Warn;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
with Snames; use Snames;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
@ -370,13 +373,32 @@ package body Exp_Ch2 is
Expand_Shared_Passive_Variable (N);
end if;
-- Test code for implementing the pragma Reviewable requirement of
-- classifying reads of scalars as referencing potentially uninitialized
-- objects or not.
if Debug_Flag_XX
and then Is_Scalar_Type (Etype (N))
and then (Is_Assignable (E) or else Is_Constant_Object (E))
and then Comes_From_Source (N)
and then not Is_LHS (N)
and then not Is_Actual_Out_Parameter (N)
and then (Nkind (Parent (N)) /= N_Attribute_Reference
or else Attribute_Name (Parent (N)) /= Name_Valid)
then
Write_Location (Sloc (N));
Write_Str (": Read from scalar """);
Write_Name (Chars (N));
Write_Str ("""");
if Is_Known_Valid (E) then
Write_Str (", Is_Known_Valid");
end if;
Write_Eol;
end if;
-- Interpret possible Current_Value for variable case
if (Ekind (E) = E_Variable
or else
Ekind (E) = E_In_Out_Parameter
or else
Ekind (E) = E_Out_Parameter)
if Is_Assignable (E)
and then Present (Current_Value (E))
then
Expand_Current_Value (N);

5
gcc/ada/exp_ch6.adb
View File

@ -1125,6 +1125,7 @@ package body Exp_Ch6 is
-- created, since we just passed it as an OUT parameter.
Kill_Current_Values (Temp);
Set_Is_Known_Valid (Temp, False);
-- If type conversion, use reverse conversion on exit
@ -2470,7 +2471,8 @@ package body Exp_Ch6 is
-- For an OUT or IN OUT parameter that is an assignable entity,
-- we do not want to clobber the Last_Assignment field, since
-- if it is set, it was precisely because it is indeed an OUT
-- or IN OUT parameter!
-- or IN OUT parameter! We do reset the Is_Known_Valid flag
-- since the subprogram could have returned in invalid value.
if (Ekind (Formal) = E_Out_Parameter
or else
@ -2480,6 +2482,7 @@ package body Exp_Ch6 is
Sav := Last_Assignment (Ent);
Kill_Current_Values (Ent);
Set_Last_Assignment (Ent, Sav);
Set_Is_Known_Valid (Ent, False);
-- For all other cases, just kill the current values

38
gcc/ada/gnat1drv.adb
View File

@ -460,25 +460,6 @@ procedure Gnat1drv is
end if;
end Check_Bad_Body;
--------------------
-- Check_Rep_Info --
--------------------
procedure Check_Rep_Info is
begin
if List_Representation_Info /= 0
or else List_Representation_Info_Mechanisms
then
Set_Standard_Error;
Write_Eol;
Write_Str
("cannot generate representation information, no code generated");
Write_Eol;
Write_Eol;
Set_Standard_Output;
end if;
end Check_Rep_Info;
-------------------------
-- Check_Library_Items --
-------------------------
@ -508,6 +489,25 @@ procedure Gnat1drv is
Walk;
end Check_Library_Items;
--------------------
-- Check_Rep_Info --
--------------------
procedure Check_Rep_Info is
begin
if List_Representation_Info /= 0
or else List_Representation_Info_Mechanisms
then
Set_Standard_Error;
Write_Eol;
Write_Str
("cannot generate representation information, no code generated");
Write_Eol;
Write_Eol;
Set_Standard_Output;
end if;
end Check_Rep_Info;
-- Start of processing for Gnat1drv
begin

4
gcc/ada/sem_aux.adb
View File

@ -312,11 +312,11 @@ package body Sem_Aux is
Ent : Entity_Id;
begin
-- If the base type has no freeze node, it is a type in standard,
-- If the base type has no freeze node, it is a type in Standard,
-- and always acts as its own first subtype unless it is one of the
-- predefined integer types. If the type is formal, it is also a first
-- subtype, and its base type has no freeze node. On the other hand, a
-- subtype of a generic formal is not its own first_subtype. Its base
-- subtype of a generic formal is not its own first subtype. Its base
-- type, if anonymous, is attached to the formal type decl. from which
-- the first subtype is obtained.

11
gcc/ada/sem_ch3.adb
View File

@ -2588,8 +2588,8 @@ package body Sem_Ch3 is
and then Is_Access_Constant (Etype (E))
then
Error_Msg_N
("access to variable cannot be initialized " &
"with an access-to-constant expression", E);
("access to variable cannot be initialized "
& "with an access-to-constant expression", E);
end if;
if not Assignment_OK (N) then
@ -2598,10 +2598,9 @@ package body Sem_Ch3 is
Check_Unset_Reference (E);
-- If this is a variable, then set current value.
-- If this is a declared constant of a scalar type
-- with a static expression, indicate that it is
-- always valid.
-- If this is a variable, then set current value. If this is a
-- declared constant of a scalar type with a static expression,
-- indicate that it is always valid.
if not Constant_Present (N) then
if Compile_Time_Known_Value (E) then

8
gcc/ada/sem_eval.adb
View File

@ -886,13 +886,15 @@ package body Sem_Eval is
and then LLo = RLo
then
-- if the range includes a single literal and we
-- can assume validity then the result is known
-- even if an operand is not static.
-- If the range includes a single literal and we can assume
-- validity then the result is known even if an operand is
-- not static.
if Assume_Valid then
return EQ;
-- Comment here ???
elsif Is_Entity_Name (L)
and then Is_Entity_Name (R)
and then Is_Known_Valid (Entity (L))

25
gcc/ada/sem_util.adb
View File

@ -5334,6 +5334,20 @@ package body Sem_Util is
and then E = Base_Type (E);
end Is_AAMP_Float;
-----------------------------
-- Is_Actual_Out_Parameter --
-----------------------------
function Is_Actual_Out_Parameter (N : Node_Id) return Boolean is
Formal : Entity_Id;
Call : Node_Id;
begin
Find_Actual (N, Formal, Call);
return Present (Formal)
and then Ekind (Formal) = E_Out_Parameter;
end Is_Actual_Out_Parameter;
-------------------------
-- Is_Actual_Parameter --
-------------------------
@ -6113,6 +6127,17 @@ package body Sem_Util is
end if;
end Is_Fully_Initialized_Variant;
------------
-- Is_LHS --
------------
function Is_LHS (N : Node_Id) return Boolean is
P : constant Node_Id := Parent (N);
begin
return Nkind (P) = N_Assignment_Statement
and then Name (P) = N;
end Is_LHS;
----------------------------
-- Is_Inherited_Operation --
----------------------------

7
gcc/ada/sem_util.ads
View File

@ -629,6 +629,9 @@ package Sem_Util is
-- the dependency of Einfo on Targparm which would be required for a
-- synthesized attribute.
function Is_Actual_Out_Parameter (N : Node_Id) return Boolean;
-- Determines if N is an actual parameter of out mode in a subprogram call
function Is_Actual_Parameter (N : Node_Id) return Boolean;
-- Determines if N is an actual parameter in a subprogram call
@ -703,6 +706,10 @@ package Sem_Util is
-- E is a subprogram. Return True is E is an implicit operation inherited
-- by a derived type declarations.
function Is_LHS (N : Node_Id) return Boolean;
-- Returns True iff N is an identifier used as Name in an assignment
-- statement.
function Is_Library_Level_Entity (E : Entity_Id) return Boolean;
-- A library-level declaration is one that is accessible from Standard,
-- i.e. a library unit or an entity declared in a library package.