From: Javier Miranda <miranda@adacore.com>
Date: Wed, 24 Jun 2020 19:05:14 +0000 (-0400)
Subject: [Ada] Ada2020: AI12-0003 Specifying the standard storage pool
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=cba9c0267ac33cc1e5b14c71d2fc75ca9609cf91;p=gcc.git

[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.
---

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