[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

5 files changed, 58 insertions, 11 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6cfab5c..2508317 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,21 @@
 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
 	are in the context of the main unit body.
 
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 83196ec..f6a83bd 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1834,8 +1834,8 @@ package body Exp_Ch6 is
 
          else
             Indic :=
-              (Subtype_Indication
-                (Type_Definition (Original_Node (Parent (S)))));
+              Subtype_Indication
+                (Type_Definition (Original_Node (Parent (S))));
 
             if Nkind (Indic) = N_Subtype_Indication then
                Par := Entity (Subtype_Mark (Indic));
@@ -1850,7 +1850,6 @@ package body Exp_Ch6 is
            or else not In_Open_Scopes (Scope (Par))
          then
             return Empty;
-
          else
             Gen_Par := Generic_Parent_Type (Parent (Par));
          end if;
@@ -1919,7 +1918,7 @@ package body Exp_Ch6 is
       Scop          : 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
       --  actual is a function call that has been transformed from a selected
       --  component, the original node is unanalyzed. Otherwise, it carries
@@ -2038,11 +2037,10 @@ package body Exp_Ch6 is
          end;
       end if;
 
-      --  First step, compute extra actuals, corresponding to any
-      --  Extra_Formals present. Note that we do not access Extra_Formals
-      --  directly, instead we simply note the presence of the extra
-      --  formals as we process the regular formals and collect the
-      --  corresponding actuals in Extra_Actuals.
+      --  First step, compute extra actuals, corresponding to any Extra_Formals
+      --  present. Note that we do not access Extra_Formals directly, instead
+      --  we simply note the presence of the extra formals as we process the
+      --  regular formals collecting corresponding actuals in Extra_Actuals.
 
       --  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.
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 463d212..94b2acf 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1770,6 +1770,14 @@ package body Sem is
 
             begin
                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 Unit_Num /= Get_Source_Unit (System_Aux_Id)
                  and then not Circular_Dependence (Body_Unit)
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index b569d70..b96b9d9 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2598,12 +2598,20 @@ package body Sem_Ch3 is
 
          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 Compile_Time_Known_Value (E) then
                Set_Current_Value (Id, E);
             end if;
+
+         elsif Is_Scalar_Type (T)
+           and then Is_OK_Static_Expression (E)
+         then
+            Set_Is_Known_Valid (Id);
          end if;
 
          --  Deal with setting of null flags
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 303f66e..385337a 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -885,7 +885,24 @@ package body Sem_Eval is
                  and then RLo = RHi
                  and then LLo = RLo
                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
                   return LE;