sem_res.adb (Large_Storage_Type): A type is large if it requires as many bits as…

sem_res.adb (Large_Storage_Type): A type is large if it requires as many bits as Positive to store its values and...

    gcc/ada/
	* sem_res.adb (Large_Storage_Type): A type is large if it
	requires as many bits as Positive to store its values and its
	bounds are known at compile time.
	* sem_ch13.adb (Minimum_Size): Note that this function returns
	0 if the size is not known at compile time.

    gcc/testsuite/
	* gnat.dg/specs/oversize.ads: New.

From-SVN: r136532

gcc/ada/ChangeLog

+2008-06-07  Samuel Tardieu  <sam@rfc1149.net>
+
+	* sem_res.adb (Large_Storage_Type): A type is large if it
+	requires as many bits as Positive to store its values and its
+	bounds are known at compile time.
+	* sem_ch13.adb (Minimum_Size): Note that this function returns
+	0 if the size is not known at compile time.
+
 2008-06-06  Nicolas Setton  <setton@adacore.com>
 	    Olivier Hainque  <hainque@adacore.com>
 

gcc/ada/sem_ch13.ads

@@ -64,7 +64,8 @@ package Sem_Ch13 is
    --  the given type, of the size the type would have if it were biased. If
    --  the type is already biased, then Minimum_Size returns the biased size,
    --  regardless of the setting of Biased. Also, fixed-point types are never
-   --  biased in the current implementation.
+   --  biased in the current implementation. If the size is not known at
+   --  compile time, this function returns 0.
 
    procedure Check_Constant_Address_Clause (Expr : Node_Id; U_Ent : Entity_Id);
    --  Expr is an expression for an address clause. This procedure checks

gcc/ada/sem_res.adb

@@ -56,6 +56,7 @@ with Sem_Cat;  use Sem_Cat;
 with Sem_Ch4;  use Sem_Ch4;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
+with Sem_Ch13; use Sem_Ch13;
 with Sem_Disp; use Sem_Disp;
 with Sem_Dist; use Sem_Dist;
 with Sem_Elab; use Sem_Elab;
@@ -471,12 +472,15 @@ package body Sem_Res is
 
                function Large_Storage_Type (T : Entity_Id) return Boolean is
                begin
-                  return
-                    T = Standard_Integer
-                      or else
-                    T = Standard_Positive
-                      or else
-                    T = Standard_Natural;
+                  --  The type is considered large if its bounds are known at
+                  --  compile time and if it requires at least as many bits as
+                  --  a Positive to store the possible values.
+
+                  return Compile_Time_Known_Value (Type_Low_Bound (T))
+                    and then Compile_Time_Known_Value (Type_High_Bound (T))
+                    and then
+                      Minimum_Size (T, Biased => True) >=
+                        Esize (Standard_Integer) - 1;
                end Large_Storage_Type;
 
             begin

gcc/testsuite/ChangeLog

+2008-06-07  Samuel Tardieu  <sam@rfc1149.net>
+
+	* gnat.dg/specs/oversize.ads: New.
+
 2008-06-07  Paolo Carlini  <paolo.carlini@oracle.com>
 
         PR c++/35327

gcc/testsuite/gnat.dg/specs/oversize.ads

+with Ada.Numerics.Discrete_Random;
+
+package Oversize is
+
+   subtype M1 is Integer range 1 .. 200;                    -- Won't trigger
+   type R1 (D : M1 := 100) is record
+      Name : String (1 .. D);
+   end record;
+
+   type M2 is new Integer range 1 .. 200;                   -- Won't trigger
+   for M2'Size use 64;
+   type M2S is array (M2 range <>) of Character;
+   type R2 (D : M2 := 100) is record
+      Name : M2S (1 .. D);
+   end record;
+
+   subtype M3 is Integer;                                   -- Will trigger
+   type R3 (D : M3 := 100) -- { dg-error "may raise Storage_Error" }
+   is record
+      Name : String (1 .. D);
+   end record;
+
+   type M4 is new Positive;                                 -- Will trigger
+   type M4S is array (M4 range <>) of Character;
+   type R4 (D : M4 := 100) -- { dg-error "may raise Storage_Error" }
+   is record
+      Name : M4S (1 .. D);
+   end record;
+
+   type M5 is new Positive;                                 -- Will trigger
+   for M5'Size use Integer'Size - 1;
+   type M5S is array (M5 range <>) of Character;
+   type R5 (D : M5 := 100) -- { dg-error "may raise Storage_Error" }
+   is record
+      Name : M5S (1 .. D);
+   end record;
+
+   subtype M6 is Integer range 1 .. (Integer'Last + 1)/2;   -- Won't trigger
+   type R6 (D : M6 := 100) is record
+      Name : String (1 .. D);
+   end record;
+
+   subtype M7 is Integer range 1 .. (Integer'Last + 1)/2+1; -- Will trigger
+   type R7 (D : M7 := 100) -- { dg-error "may raise Storage_Error" }
+   is record
+      Name : String (1 .. D);
+   end record;
+
+   package P8 is new Ada.Numerics.Discrete_Random (Natural);
+   G8 : P8.Generator;
+   subtype M8 is Integer range 1 .. P8.Random (G8);         -- Won't trigger
+   type R8 (D : M8 := 100) is record
+      Name : String (1 .. D);
+   end record;
+
+end Oversize;