Commit 57036dcc by Ed Schonberg Committed by Arnaud Charlet

[multiple changes]

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

	* sem_eval.adb (Compile_Time_Compare): More precise handling of
	Known_Valid flag, to prevent spurious range deductions when scalar
	variables may be uninitialized. New predicate Is_Known_Valid_Operand.

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

	* sem.adb: Minor reformatting

From-SVN: r150118
parent d33744e4
2009-07-27 Ed Schonberg <schonberg@adacore.com>
* sem_eval.adb (Compile_Time_Compare): More precise handling of
Known_Valid flag, to prevent spurious range deductions when scalar
variables may be uninitialized. New predicate Is_Known_Valid_Operand.
2009-07-27 Robert Dewar <dewar@adacore.com> 2009-07-27 Robert Dewar <dewar@adacore.com>
* gnatfind.adb, osint.ads, sem.adb, xr_tabls.adb: Minor reformatting * gnatfind.adb, osint.ads, sem.adb, xr_tabls.adb: Minor reformatting
......
...@@ -1967,7 +1967,7 @@ package body Sem is ...@@ -1967,7 +1967,7 @@ package body Sem is
-- with_clauses. Do not process main unit prematurely. -- with_clauses. Do not process main unit prematurely.
if Pnode = CU if Pnode = CU
and then (CU /= Cunit (Main_Unit)) and then CU /= Cunit (Main_Unit)
then then
Walk_Immediate (Cunit (S), Include_Limited); Walk_Immediate (Cunit (S), Include_Limited);
end if; end if;
......
...@@ -424,6 +424,10 @@ package body Sem_Eval is ...@@ -424,6 +424,10 @@ package body Sem_Eval is
-- have a 'Last/'First reference in which case the value returned is the -- have a 'Last/'First reference in which case the value returned is the
-- appropriate type bound. -- appropriate type bound.
function Is_Known_Valid_Operand (Opnd : Node_Id) return Boolean;
-- Even if the context does not assume that values are valid, some
-- simple cases can be recognized.
function Is_Same_Value (L, R : Node_Id) return Boolean; function Is_Same_Value (L, R : Node_Id) return Boolean;
-- Returns True iff L and R represent expressions that definitely -- Returns True iff L and R represent expressions that definitely
-- have identical (but not necessarily compile time known) values -- have identical (but not necessarily compile time known) values
...@@ -522,7 +526,7 @@ package body Sem_Eval is ...@@ -522,7 +526,7 @@ package body Sem_Eval is
else -- Attribute_Name (N) = Name_Last else -- Attribute_Name (N) = Name_Last
return Make_Integer_Literal (Sloc (N), return Make_Integer_Literal (Sloc (N),
Intval => Intval (String_Literal_Low_Bound (Xtyp)) Intval => Intval (String_Literal_Low_Bound (Xtyp))
+ String_Literal_Length (Xtyp)); + String_Literal_Length (Xtyp));
end if; end if;
end if; end if;
...@@ -551,6 +555,22 @@ package body Sem_Eval is ...@@ -551,6 +555,22 @@ package body Sem_Eval is
return N; return N;
end Compare_Fixup; end Compare_Fixup;
----------------------------
-- Is_Known_Valid_Operand --
----------------------------
function Is_Known_Valid_Operand (Opnd : Node_Id) return Boolean is
begin
return (Is_Entity_Name (Opnd)
and then
(Is_Known_Valid (Entity (Opnd))
or else Ekind (Entity (Opnd)) = E_In_Parameter
or else
(Ekind (Entity (Opnd)) in Object_Kind
and then Present (Current_Value (Entity (Opnd))))))
or else Is_OK_Static_Expression (Opnd);
end Is_Known_Valid_Operand;
------------------- -------------------
-- Is_Same_Value -- -- Is_Same_Value --
------------------- -------------------
...@@ -560,12 +580,11 @@ package body Sem_Eval is ...@@ -560,12 +580,11 @@ package body Sem_Eval is
Rf : constant Node_Id := Compare_Fixup (R); Rf : constant Node_Id := Compare_Fixup (R);
function Is_Same_Subscript (L, R : List_Id) return Boolean; function Is_Same_Subscript (L, R : List_Id) return Boolean;
-- L, R are the Expressions values from two attribute nodes -- L, R are the Expressions values from two attribute nodes for First
-- for First or Last attributes. Either may be set to No_List -- or Last attributes. Either may be set to No_List if no expressions
-- if no expressions are present (indicating subscript 1). -- are present (indicating subscript 1). The result is True if both
-- The result is True if both expressions represent the same -- expressions represent the same subscript (note one case is where
-- subscript (note that one case is where one subscript is -- one subscript is missing and the other is explicitly set to 1).
-- missing and the other is explicitly set to 1).
----------------------- -----------------------
-- Is_Same_Subscript -- -- Is_Same_Subscript --
...@@ -892,16 +911,6 @@ package body Sem_Eval is ...@@ -892,16 +911,6 @@ package body Sem_Eval is
if Assume_Valid then if Assume_Valid then
return EQ; return EQ;
-- Comment here ???
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 else
return Unknown; return Unknown;
end if; end if;
...@@ -911,6 +920,15 @@ package body Sem_Eval is ...@@ -911,6 +920,15 @@ package body Sem_Eval is
elsif RHi = LLo then elsif RHi = LLo then
return GE; return GE;
elsif not Is_Known_Valid_Operand (L)
and then not Assume_Valid
then
if Is_Same_Value (L, R) then
return EQ;
else
return Unknown;
end if;
end if; end if;
end if; end if;
end; end;
......
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