From cba9c0267ac33cc1e5b14c71d2fc75ca9609cf91 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Wed, 24 Jun 2020 15:05:14 -0400 Subject: [PATCH] [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. --- gcc/ada/freeze.adb | 7 ++++++- 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 50327240450..b3aa13156df 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 d10d00de38e..b3fa7344dac 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 -- 2.30.2