aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorCyrille Comar <comar@act-europe.fr>2004-10-27 15:41:23 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2004-10-27 15:41:23 +0200
commitfe98a6aa82871e555908dac1f04225b7d6631db4 (patch)
tree643fdd5de6d854ea33ca10ad589c8bd839c75491 /gcc
parentdb09b5b61bf12f4ca99ab11461f87c6dc9506e25 (diff)
downloadgcc-fe98a6aa82871e555908dac1f04225b7d6631db4.zip
gcc-fe98a6aa82871e555908dac1f04225b7d6631db4.tar.gz
gcc-fe98a6aa82871e555908dac1f04225b7d6631db4.tar.bz2
sem_ch13.adb (Analyze_Attribute_Definition_Clause, [...]): enhance, document & limit detection of non-sharable internal pools.
2004-10-26 Cyrille Comar <comar@act-europe.fr> * sem_ch13.adb (Analyze_Attribute_Definition_Clause, case 'Storage_Pool): enhance, document & limit detection of non-sharable internal pools. * impunit.adb: Make System.Pool_Global and System.Pool_Local visible. * s-pooglo.ads: Add more documentation now that this pool is properly documented. From-SVN: r89669
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/impunit.adb2
-rw-r--r--gcc/ada/s-pooglo.ads10
-rw-r--r--gcc/ada/sem_ch13.adb44
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);