diff options
| -rw-r--r-- | gcc/ada/impunit.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/s-pooglo.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 44 |
3 files changed, 32 insertions, 24 deletions
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 189ee91..d2e1d5d 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -297,6 +297,8 @@ package body Impunit is "s-assert", -- System.Assertions "s-memory", -- System.Memory "s-parint", -- System.Partition_Interface + "s-pooglo", -- System.Pool_Global + "s-pooloc", -- System.Pool_Local "s-restri", -- System.Restrictions "s-rident", -- System.Rident "s-tasinf", -- System.Task_Info diff --git a/gcc/ada/s-pooglo.ads b/gcc/ada/s-pooglo.ads index 16e03de..67045ad 100644 --- a/gcc/ada/s-pooglo.ads +++ b/gcc/ada/s-pooglo.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992,1993,1994 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-1994, 2004 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -47,7 +47,8 @@ pragma Elaborate_Body; -- no automatic reclaim -- minimal overhead - -- Default pool in the compiler for access types globally declared + -- Pool simulating the allocation/deallocation strategy used by the + -- compiler for access types globally declared. type Unbounded_No_Reclaim_Pool is new System.Storage_Pools.Root_Storage_Pool with null record; @@ -68,7 +69,10 @@ pragma Elaborate_Body; Storage_Size : System.Storage_Elements.Storage_Count; Alignment : System.Storage_Elements.Storage_Count); - -- Pool object for the compiler + -- Pool object used by the compiler when implicit Storage Pool objects are + -- explicitly referred to. For instance when writing something like: + -- for T'Storage_Pool use Q'Storage_Pool; + -- and Q'Storage_Pool hasn't been defined explicitly. Global_Pool_Object : Unbounded_No_Reclaim_Pool; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index a3fadf2..6613ee6 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1250,6 +1250,7 @@ package body Sem_Ch13 is when Attribute_Storage_Pool => Storage_Pool : declare Pool : Entity_Id; + T : Entity_Id; begin if Ekind (U_Ent) /= E_Access_Type @@ -1276,6 +1277,26 @@ package body Sem_Ch13 is Analyze_And_Resolve (Expr, Class_Wide_Type (RTE (RE_Root_Storage_Pool))); + if Nkind (Expr) = N_Type_Conversion then + T := Etype (Expression (Expr)); + else + T := Etype (Expr); + end if; + + -- The Stack_Bounded_Pool is used internally for implementing + -- access types with a Storage_Size. Since it only work + -- properly when used on one specific type, we need to check + -- that it is not highjacked improperly: + -- type T is access Integer; + -- for T'Storage_Size use n; + -- type Q is access Float; + -- for Q'Storage_Size use T'Storage_Size; -- incorrect + + if Base_Type (T) = RTE (RE_Stack_Bounded_Pool) then + Error_Msg_N ("non-sharable internal Pool", Expr); + return; + end if; + -- If the argument is a name that is not an entity name, then -- we construct a renaming operation to define an entity of -- type storage pool. @@ -1320,33 +1341,14 @@ package body Sem_Ch13 is Pool := Entity (Expression (Renamed_Object (Pool))); end if; - if Present (Etype (Pool)) - and then Etype (Pool) /= RTE (RE_Stack_Bounded_Pool) - and then Etype (Pool) /= RTE (RE_Unbounded_Reclaim_Pool) - then - Set_Associated_Storage_Pool (U_Ent, Pool); - else - Error_Msg_N ("Non sharable GNAT Pool", Expr); - end if; - - -- The pool may be specified as the Storage_Pool of some other - -- type. It is rewritten as a class_wide conversion of the - -- corresponding pool entity. + Set_Associated_Storage_Pool (U_Ent, Pool); elsif Nkind (Expr) = N_Type_Conversion and then Is_Entity_Name (Expression (Expr)) and then Nkind (Original_Node (Expr)) = N_Attribute_Reference then Pool := Entity (Expression (Expr)); - - if Present (Etype (Pool)) - and then Etype (Pool) /= RTE (RE_Stack_Bounded_Pool) - and then Etype (Pool) /= RTE (RE_Unbounded_Reclaim_Pool) - then - Set_Associated_Storage_Pool (U_Ent, Pool); - else - Error_Msg_N ("Non sharable GNAT Pool", Expr); - end if; + Set_Associated_Storage_Pool (U_Ent, Pool); else Error_Msg_N ("incorrect reference to a Storage Pool", Expr); |