From 09066160c7184c030528e4ff559b66a4ccdcb9a5 Mon Sep 17 00:00:00 2001 From: sam Date: Sat, 7 Jun 2008 16:10:50 +0000 Subject: [PATCH] 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@136532 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 8 +++++ gcc/ada/sem_ch13.ads | 3 +- gcc/ada/sem_res.adb | 16 +++++---- gcc/testsuite/ChangeLog | 4 +++ gcc/testsuite/gnat.dg/specs/oversize.ads | 56 ++++++++++++++++++++++++++++++++ 5 files changed, 80 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/specs/oversize.ads 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 + + * 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 Olivier Hainque 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 + + * gnat.dg/specs/oversize.ads: New. + 2008-06-07 Paolo Carlini 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; -- 2.7.4