diff options
author | Samuel Tardieu <sam@rfc1149.net> | 2008-06-07 16:10:50 +0000 |
---|---|---|
committer | Samuel Tardieu <sam@gcc.gnu.org> | 2008-06-07 16:10:50 +0000 |
commit | 4b92fd3cc91f9406ba26c73aaa03ef0f5871fa99 (patch) | |
tree | 0e35d02f3c3abeff9f6bae58cc6b8c07f2f35293 | |
parent | e32764576e31e938e1257dd55e5c151db7a87e9e (diff) | |
download | gcc-4b92fd3cc91f9406ba26c73aaa03ef0f5871fa99.zip gcc-4b92fd3cc91f9406ba26c73aaa03ef0f5871fa99.tar.gz gcc-4b92fd3cc91f9406ba26c73aaa03ef0f5871fa99.tar.bz2 |
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
-rw-r--r-- | gcc/ada/ChangeLog | 8 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.ads | 3 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 16 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/specs/oversize.ads | 56 |
5 files changed, 80 insertions, 7 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4a5a535..4a2da86b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +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> diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index e7c20bc..175f304 100644 --- a/gcc/ada/sem_ch13.ads +++ b/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 diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 8001087..a6d42f7 100644 --- a/gcc/ada/sem_res.adb +++ b/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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 40e8b51..109b1d8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +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 diff --git a/gcc/testsuite/gnat.dg/specs/oversize.ads b/gcc/testsuite/gnat.dg/specs/oversize.ads new file mode 100644 index 0000000..e98c8bd --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/oversize.ads @@ -0,0 +1,56 @@ +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; |