diff options
| author | Javier Miranda <miranda@adacore.com> | 2020-06-24 15:05:14 -0400 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-10-15 05:39:13 -0400 |
| commit | cba9c0267ac33cc1e5b14c71d2fc75ca9609cf91 (patch) | |
| tree | d84224d70eced82ab7b88f0f911846a3505c4a59 /gcc | |
| parent | 952604032ac5a2804d0f36de7e329902f0340a8e (diff) | |
| download | gcc-cba9c0267ac33cc1e5b14c71d2fc75ca9609cf91.zip gcc-cba9c0267ac33cc1e5b14c71d2fc75ca9609cf91.tar.gz gcc-cba9c0267ac33cc1e5b14c71d2fc75ca9609cf91.tar.bz2 | |
[Ada] Ada2020: AI12-0003 Specifying the standard storage pool
gcc/ada/
* sem_prag.adb (Analyze_Pragma): Adding semantic support of
Standard to Default_Storage_Pool.
* freeze.adb (Freeze_Entity): If pragma Default_Storage_Pool
applies and it is set to Standard then use the global pool as
the associated storage pool of the access type.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/freeze.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 16 |
2 files changed, 20 insertions, 3 deletions
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 5032724..b3aa131 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -6387,7 +6387,7 @@ package body Freeze is end if; -- The pool applies to named and anonymous access types, but not - -- to subprogram and to internal types generated for 'Access + -- to subprogram and to internal types generated for 'Access -- references. elsif Is_Access_Type (E) @@ -6412,6 +6412,11 @@ package body Freeze is if Nkind (Default_Pool) = N_Null then Set_No_Pool_Assigned (E); + -- Case of pragma Default_Storage_Pool (Standard) + + elsif Entity (Default_Pool) = Standard_Standard then + Set_Associated_Storage_Pool (E, RTE (RE_Global_Pool_Object)); + -- Case of pragma Default_Storage_Pool (storage_pool_NAME) else diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d10d00d..b3fa734 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -15314,7 +15314,7 @@ package body Sem_Prag is -- Default_Storage_Pool -- -------------------------- - -- pragma Default_Storage_Pool (storage_pool_NAME | null); + -- pragma Default_Storage_Pool (storage_pool_NAME | null | Standard); when Pragma_Default_Storage_Pool => Default_Storage_Pool : declare Pool : Node_Id; @@ -15355,6 +15355,18 @@ package body Sem_Prag is Set_Etype (Pool, Empty); + -- Case of Default_Storage_Pool (Standard); + + elsif Nkind (Pool) = N_Identifier + and then Chars (Pool) = Name_Standard + then + Analyze (Pool); + + if Entity (Pool) /= Standard_Standard then + Error_Pragma_Arg + ("package Standard is not directly visible", Arg1); + end if; + -- Case of Default_Storage_Pool (storage_pool_NAME); else @@ -15362,7 +15374,7 @@ package body Sem_Prag is -- argument is "null". if Is_Configuration_Pragma then - Error_Pragma_Arg ("NULL expected", Arg1); + Error_Pragma_Arg ("NULL or Standard expected", Arg1); end if; -- The expected type for a non-"null" argument is |