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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150118 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bd34c32..e4efbe3 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+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>
 
        * gnatfind.adb, osint.ads, sem.adb, xr_tabls.adb: Minor reformatting

diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index b8ad571..d40b55c 100644 (file)
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1967,7 +1967,7 @@ package body Sem is
                   --  with_clauses. Do not process main unit prematurely.
 
                   if Pnode = CU
-                    and then (CU /= Cunit (Main_Unit))
+                    and then CU /= Cunit (Main_Unit)
                   then
                      Walk_Immediate (Cunit (S), Include_Limited);
                   end if;

diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index eb3ec12..18853d7 100644 (file)
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -424,6 +424,10 @@ package body Sem_Eval is
       --  have a 'Last/'First reference in which case the value returned is the
       --  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;
       --  Returns True iff L and R represent expressions that definitely
       --  have identical (but not necessarily compile time known) values
@@ -522,7 +526,7 @@ package body Sem_Eval is
                else         -- Attribute_Name (N) = Name_Last
                   return Make_Integer_Literal (Sloc (N),
                     Intval => Intval (String_Literal_Low_Bound (Xtyp))
-                       + String_Literal_Length (Xtyp));
+                                + String_Literal_Length (Xtyp));
                end if;
             end if;
 
@@ -551,6 +555,22 @@ package body Sem_Eval is
          return N;
       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 --
       -------------------
@@ -560,12 +580,11 @@ package body Sem_Eval is
          Rf : constant Node_Id := Compare_Fixup (R);
 
          function Is_Same_Subscript (L, R : List_Id) return Boolean;
-         --  L, R are the Expressions values from two attribute nodes
-         --  for First or Last attributes. Either may be set to No_List
-         --  if no expressions are present (indicating subscript 1).
-         --  The result is True if both expressions represent the same
-         --  subscript (note that one case is where one subscript is
-         --  missing and the other is explicitly set to 1).
+         --  L, R are the Expressions values from two attribute nodes for First
+         --  or Last attributes. Either may be set to No_List if no expressions
+         --  are present (indicating subscript 1). The result is True if both
+         --  expressions represent the same subscript (note one case is where
+         --  one subscript is missing and the other is explicitly set to 1).
 
          -----------------------
          -- Is_Same_Subscript --
@@ -892,16 +911,6 @@ package body Sem_Eval is
 
                   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))
-                    and then Is_Known_Valid (Entity (R))
-                  then
-                     return EQ;
-
                   else
                      return Unknown;
                   end if;
@@ -911,6 +920,15 @@ package body Sem_Eval is
 
                elsif RHi = LLo then
                   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;