[multiple changes]

2009-06-19  Eric Botcazou  <ebotcazou@adacore.com>

	* einfo.ads (Handling of Type'Size Values): Fix Object_Size values.

2009-06-19  Robert Dewar  <dewar@adacore.com>

	* a-nudira.adb (Need_64): Handle negative ranges and also dynamic
	ranges

	* checks.adb (Determine_Range): Move the test for generic types later.

	* sem_eval.adb (Compile_Time_Compare): Improve circuitry to catch more
	cases.
	(Eval_Relational_Op): Fold more cases including string compares

	* sem_util.ads, sem_util.adb (References_Generic_Formal_Type): New
	function.

From-SVN: r148697

gcc/ada/ChangeLog

+2009-06-19  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* einfo.ads (Handling of Type'Size Values): Fix Object_Size values.
+
+2009-06-19  Robert Dewar  <dewar@adacore.com>
+
+	* a-nudira.adb (Need_64): Handle negative ranges and also dynamic
+	ranges
+
+	* checks.adb (Determine_Range): Move the test for generic types later.
+
+	* sem_eval.adb (Compile_Time_Compare): Improve circuitry to catch more
+	cases.
+	(Eval_Relational_Op): Fold more cases including string compares
+
+	* sem_util.ads, sem_util.adb (References_Generic_Formal_Type): New
+	function.
+
 2009-06-19  Robert Dewar  <dewar@adacore.com>
 
 	* sem_type.ads, sem_ch12.adb: Minor reformatting

gcc/ada/a-nudira.adb

@@ -51,11 +51,24 @@ package body Ada.Numerics.Discrete_Random is
 
    type Pointer is access all State;
 
-   Need_64 : constant Boolean := Rst'Pos (Rst'Last) > Int'Last;
+   Need_64 : constant Boolean := Rst'Pos (Rst'Last) > 2**31 - 1
+                                   or else
+                                 Rst'Pos (Rst'First) < 2**31;
    --  Set if we need more than 32 bits in the result. In practice we will
    --  only use the meaningful 48 bits of any 64 bit number generated, since
    --  if more than 48 bits are required, we split the computation into two
    --  separate parts, since the algorithm does not behave above 48 bits.
+   --
+   --  Note: the right hand side used to be Int'Last, but that won't work
+   --  since it means that if Rst is a dynamic subtype, the comparison is
+   --  evaluated at run time in type Int, which is too small. In practice
+   --  the use of dynamic bounds is rare, and this constant will always
+   --  be evaluated at compile time in an instance.
+   --
+   --  This still is not quite right for dynamic subtypes of 64-bit modular
+   --  types where the upper bound can exceed the upper bound of universal
+   --  integer. Not clear how to do this with a nice static expression ???
+   --  Might have to introduce a special Type'First_In_32_Bits attribute!
 
    -----------------------
    -- Local Subprograms --

gcc/ada/checks.adb

@@ -3065,7 +3065,7 @@ package body Checks is
       function OK_Operands return Boolean;
       --  Used for binary operators. Determines the ranges of the left and
       --  right operands, and if they are both OK, returns True, and puts
-      --  the results in Lo_Right, Hi_Right, Lo_Left, Hi_Left
+      --  the results in Lo_Right, Hi_Right, Lo_Left, Hi_Left.
 
       -----------------
       -- OK_Operands --
@@ -3108,10 +3108,6 @@ package body Checks is
         --  ignore if error posted on the reference node.
 
         or else Error_Posted (N) or else Error_Posted (Typ)
-
-        --  Ignore generic type, since range is indeed bogus
-
-        or else Is_Generic_Type (Typ)
       then
          OK := False;
          return;
@@ -3148,6 +3144,15 @@ package body Checks is
       --  overflow situation, which is a separate check, we are talking here
       --  only about the expression value).
 
+      --  First a check, never try to find the bounds of a generic type, since
+      --  these bounds are always junk values, and it is only valid to look at
+      --  the bounds in an instance.
+
+      if Is_Generic_Type (Typ) then
+         OK := False;
+         return;
+      end if;
+
       --  First step, change to use base type unless we know the value is valid
 
       if (Is_Entity_Name (N) and then Is_Known_Valid (Entity (N)))

gcc/ada/einfo.ads

@@ -214,13 +214,13 @@ package Einfo is
 --     type x1 is range 0..5;                      8               3
 
 --     type x2 is range 0..5;
---     for x2'size use 12;                        12              12
+--     for x2'size use 12;                        16              12
 
---     subtype x3 is x2 range 0 .. 3;             12               2
+--     subtype x3 is x2 range 0 .. 3;             16               2
 
 --     subtype x4 is x2'base range 0 .. 10;        8               4
 
---     subtype x5 is x2 range 0 .. dynamic;       12              (7)
+--     subtype x5 is x2 range 0 .. dynamic;       16              (7)
 
 --     subtype x6 is x2'base range 0 .. dynamic;   8              (7)
 
@@ -2081,9 +2081,9 @@ package Einfo is
 --       (generic function, generic subprogram), False for all other entities.
 
 --    Is_Generic_Type (Flag13)
---       Present in all types and subtypes. Set for types which are generic
---       formal types. Such types have an Ekind that corresponds to their
---       classification, so the Ekind cannot be used to identify generic types.
+--       Present in all entities. Set for types which are generic formal types.
+--       Such types have an Ekind that corresponds to their classification, so
+--       the Ekind cannot be used to identify generic types.
 
 --    Is_Generic_Unit (synthesized)
 --       Applies to all entities. Yields True for a generic unit (generic
@@ -4503,6 +4503,7 @@ package Einfo is
    --    Is_First_Subtype                    (Flag70)
    --    Is_Formal_Subprogram                (Flag111)
    --    Is_Generic_Instance                 (Flag130)
+   --    Is_Generic_Type                     (Flag13)
    --    Is_Hidden                           (Flag57)
    --    Is_Hidden_Open_Scope                (Flag171)
    --    Is_Immediately_Visible              (Flag7)
@@ -4609,7 +4610,6 @@ package Einfo is
    --    Is_Eliminated                       (Flag124)
    --    Is_Frozen                           (Flag4)
    --    Is_Generic_Actual_Type              (Flag94)
-   --    Is_Generic_Type                     (Flag13)
    --    Is_Protected_Interface              (Flag198)
    --    Is_RACW_Stub_Type                   (Flag244)
    --    Is_Synchronized_Interface           (Flag199)

gcc/ada/sem_util.adb

@@ -9482,6 +9482,51 @@ package body Sem_Util is
       return Token_Node;
    end Real_Convert;
 
+   ------------------------------------
+   -- References_Generic_Formal_Type --
+   ------------------------------------
+
+   function References_Generic_Formal_Type (N : Node_Id) return Boolean is
+
+      function Process (N : Node_Id) return Traverse_Result;
+      --  Process one node in search for generic formal type
+
+      -------------
+      -- Process --
+      -------------
+
+      function Process (N : Node_Id) return Traverse_Result is
+      begin
+         if Nkind (N) in N_Has_Entity then
+            declare
+               E : constant Entity_Id := Entity (N);
+            begin
+               if Present (E) then
+                  if Is_Generic_Type (E) then
+                     return Abandon;
+                  elsif Present (Etype (E))
+                    and then Is_Generic_Type (Etype (E))
+                  then
+                     return Abandon;
+                  end if;
+               end if;
+            end;
+         end if;
+
+         return Atree.OK;
+      end Process;
+
+      function Traverse is new Traverse_Func (Process);
+      --  Traverse tree to look for generic type
+
+   begin
+      if Inside_A_Generic then
+         return Traverse (N) = Abandon;
+      else
+         return False;
+      end if;
+   end References_Generic_Formal_Type;
+
    --------------------
    -- Remove_Homonym --
    --------------------

gcc/ada/sem_util.ads

@@ -1026,6 +1026,10 @@ package Sem_Util is
    --  S is a possibly signed syntactically valid real literal. The result
    --  returned is an N_Real_Literal node representing the literal value.
 
+   function References_Generic_Formal_Type (N : Node_Id) return Boolean;
+   --  Returns True if the expression Expr contains any references to a
+   --  generic type. This can only happen within a generic template.
+
    procedure Remove_Homonym (E : Entity_Id);
    --  Removes E from the homonym chain