Commit e27b834b by Arnaud Charlet

[multiple changes]

2009-07-23  Ed Schonberg  <schonberg@adacore.com>

	* sem.adb (Do_Unit_And_Dependents): Now that specs and bodies are not
	done at the same time, guard against listing a body more than once.

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

	* exp_ch6.adb: Minor reformatting

2009-07-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Analyze_Object_Declaration): A scalar constant with a
	static expression is known valid.
	* sem_eval.adb (Compile_Time_Compare): Handle properly non-static
	operands of a subtype with a single value.

From-SVN: r150009
parent 5c20b5e2
2009-07-23 Ed Schonberg <schonberg@adacore.com> 2009-07-23 Ed Schonberg <schonberg@adacore.com>
* sem.adb (Do_Unit_And_Dependents): Now that specs and bodies are not
done at the same time, guard against listing a body more than once.
2009-07-23 Robert Dewar <dewar@adacore.com>
* exp_ch6.adb: Minor reformatting
2009-07-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Analyze_Object_Declaration): A scalar constant with a
static expression is known valid.
* sem_eval.adb (Compile_Time_Compare): Handle properly non-static
operands of a subtype with a single value.
2009-07-23 Ed Schonberg <schonberg@adacore.com>
* sem.adb (Do_Units_And_Dependents): Process bodies only for units that * sem.adb (Do_Units_And_Dependents): Process bodies only for units that
are in the context of the main unit body. are in the context of the main unit body.
......
...@@ -1834,8 +1834,8 @@ package body Exp_Ch6 is ...@@ -1834,8 +1834,8 @@ package body Exp_Ch6 is
else else
Indic := Indic :=
(Subtype_Indication Subtype_Indication
(Type_Definition (Original_Node (Parent (S))))); (Type_Definition (Original_Node (Parent (S))));
if Nkind (Indic) = N_Subtype_Indication then if Nkind (Indic) = N_Subtype_Indication then
Par := Entity (Subtype_Mark (Indic)); Par := Entity (Subtype_Mark (Indic));
...@@ -1850,7 +1850,6 @@ package body Exp_Ch6 is ...@@ -1850,7 +1850,6 @@ package body Exp_Ch6 is
or else not In_Open_Scopes (Scope (Par)) or else not In_Open_Scopes (Scope (Par))
then then
return Empty; return Empty;
else else
Gen_Par := Generic_Parent_Type (Parent (Par)); Gen_Par := Generic_Parent_Type (Parent (Par));
end if; end if;
...@@ -1919,7 +1918,7 @@ package body Exp_Ch6 is ...@@ -1919,7 +1918,7 @@ package body Exp_Ch6 is
Scop : Entity_Id; Scop : Entity_Id;
Subp : Entity_Id; Subp : Entity_Id;
Prev_Orig : Node_Id; Prev_Orig : Node_Id;
-- Original node for an actual, which may have been rewritten. If the -- Original node for an actual, which may have been rewritten. If the
-- actual is a function call that has been transformed from a selected -- actual is a function call that has been transformed from a selected
-- component, the original node is unanalyzed. Otherwise, it carries -- component, the original node is unanalyzed. Otherwise, it carries
...@@ -2038,11 +2037,10 @@ package body Exp_Ch6 is ...@@ -2038,11 +2037,10 @@ package body Exp_Ch6 is
end; end;
end if; end if;
-- First step, compute extra actuals, corresponding to any -- First step, compute extra actuals, corresponding to any Extra_Formals
-- Extra_Formals present. Note that we do not access Extra_Formals -- present. Note that we do not access Extra_Formals directly, instead
-- directly, instead we simply note the presence of the extra -- we simply note the presence of the extra formals as we process the
-- formals as we process the regular formals and collect the -- regular formals collecting corresponding actuals in Extra_Actuals.
-- corresponding actuals in Extra_Actuals.
-- We also generate any required range checks for actuals for in formals -- We also generate any required range checks for actuals for in formals
-- as we go through the loop, since this is a convenient place to do it. -- as we go through the loop, since this is a convenient place to do it.
......
...@@ -1770,6 +1770,14 @@ package body Sem is ...@@ -1770,6 +1770,14 @@ package body Sem is
begin begin
if Present (Body_Unit) if Present (Body_Unit)
-- Since specs and bodies are not done at the same time,
-- guard against listing a body more than once.
and then not Seen (Get_Cunit_Unit_Number (Body_Unit))
-- Would be good to comment each of these tests ???
and then Body_Unit /= Cunit (Main_Unit) and then Body_Unit /= Cunit (Main_Unit)
and then Unit_Num /= Get_Source_Unit (System_Aux_Id) and then Unit_Num /= Get_Source_Unit (System_Aux_Id)
and then not Circular_Dependence (Body_Unit) and then not Circular_Dependence (Body_Unit)
......
...@@ -2598,12 +2598,20 @@ package body Sem_Ch3 is ...@@ -2598,12 +2598,20 @@ package body Sem_Ch3 is
Check_Unset_Reference (E); Check_Unset_Reference (E);
-- If this is a variable, then set current value -- 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 not Constant_Present (N) then
if Compile_Time_Known_Value (E) then if Compile_Time_Known_Value (E) then
Set_Current_Value (Id, E); Set_Current_Value (Id, E);
end if; end if;
elsif Is_Scalar_Type (T)
and then Is_OK_Static_Expression (E)
then
Set_Is_Known_Valid (Id);
end if; end if;
-- Deal with setting of null flags -- Deal with setting of null flags
......
...@@ -885,7 +885,24 @@ package body Sem_Eval is ...@@ -885,7 +885,24 @@ package body Sem_Eval is
and then RLo = RHi and then RLo = RHi
and then LLo = RLo and then LLo = RLo
then then
return EQ;
-- 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;
elsif Is_Entity_Name (L)
and then Is_Entity_Name (R)
and then Is_Known_Valid (Entity (L))
and then Is_Known_Valid (Entity (R))
then
return EQ;
else
return Unknown;
end if;
elsif LHi = RLo then elsif LHi = RLo then
return LE; return LE;
......
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