[multiple changes]

2010-10-18  Bob Duff  <duff@adacore.com>

	* sinfo.ads, sinfo.adb: Modify comment about adding fields to be more
	correct, and to be in a more convenient order.
	(Default_Storage_Pool): New field of N_Compilation_Unit_Aux, for
	recording the Default_Storage_Pool for a parent library unit.
	* einfo.ads (Etype): Document the case in which Etype can be Empty.
	* sem_prag.adb (Pragma_Default_Storage_Pool): Analyze the new
	Default_Storage_Pool pragma.
	* sem.ads (Save_Default_Storage_Pool): Save area for push/pop scopes.
	* gnat_ugn.texi: Document Default_Storage_Pool as a new configuration
	pragma.
	* freeze.adb (Freeze_Entity): When freezing an access type, take into
	account any Default_Storage_Pool pragma that applies. We have to do
	this at the freezing point, because up until that point, a Storage_Pool
	or Storage_Size clause could occur, which should override the
	Default_Storage_Pool.
	* par-prag.adb: Add this pragma to the list of pragmas handled entirely
	during semantics.
	* sem_ch8.adb (Push_Scope, Pop_Scope): Save and restore the
	Default_Storage_Pool information.
	* opt.ads (Default_Pool, Default_Pool_Config): New globals for recording
	currently-applicable Default_Storage_Pool pragmas.
	* opt.adb: Save/restore the globals as appropriate.
	* snames.ads-tmpl (Name_Default_Storage_Pool,
	Pragma_Default_Storage_Pool): New pragma name.

2010-10-18  Vincent Celier  <celier@adacore.com>

	* make.adb (Switches_Of): Put the spec and body suffix in canonical
	case.

From-SVN: r165637

gcc/ada/ChangeLog

+2010-10-18  Bob Duff  <duff@adacore.com>
+
+	* sinfo.ads, sinfo.adb: Modify comment about adding fields to be more
+	correct, and to be in a more convenient order.
+	(Default_Storage_Pool): New field of N_Compilation_Unit_Aux, for
+	recording the Default_Storage_Pool for a parent library unit.
+	* einfo.ads (Etype): Document the case in which Etype can be Empty.
+	* sem_prag.adb (Pragma_Default_Storage_Pool): Analyze the new
+	Default_Storage_Pool pragma.
+	* sem.ads (Save_Default_Storage_Pool): Save area for push/pop scopes.
+	* gnat_ugn.texi: Document Default_Storage_Pool as a new configuration
+	pragma.
+	* freeze.adb (Freeze_Entity): When freezing an access type, take into
+	account any Default_Storage_Pool pragma that applies. We have to do
+	this at the freezing point, because up until that point, a Storage_Pool
+	or Storage_Size clause could occur, which should override the
+	Default_Storage_Pool.
+	* par-prag.adb: Add this pragma to the list of pragmas handled entirely
+	during semantics.
+	* sem_ch8.adb (Push_Scope, Pop_Scope): Save and restore the
+	Default_Storage_Pool information.
+	* opt.ads (Default_Pool, Default_Pool_Config): New globals for recording
+	currently-applicable Default_Storage_Pool pragmas.
+	* opt.adb: Save/restore the globals as appropriate.
+	* snames.ads-tmpl (Name_Default_Storage_Pool,
+	Pragma_Default_Storage_Pool): New pragma name.
+
+2010-10-18  Vincent Celier  <celier@adacore.com>
+
+	* make.adb (Switches_Of): Put the spec and body suffix in canonical
+	case.
+
 2010-10-18  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch13.adb (Analyze_Aspect_Specifications): If subprogram is at the

gcc/ada/einfo.ads

@@ -770,13 +770,12 @@ package Einfo is
 --       subtypes. Contains the Digits value specified in the declaration.
 
 --    Direct_Primitive_Operations (Elist15)
---       Present in tagged record types and subtypes, in tagged private types
---       and in tagged incomplete types. Points to an element list of entities
---       for primitive operations for the tagged type. Not present in untagged
---       types (it is an error to reference the primitive operations field of a
---       type that is not tagged). In order to fulfill the C++ ABI, entities of
---       primitives that come from source must be stored in this list following
---       their order of occurrence in the sources. For incomplete types the
+--       Present in tagged types and subtypes (including synchronized types),
+--       in tagged private types and in tagged incomplete types. Element list
+--       of entities for primitive operations of the tagged type. Not present
+--       in untagged types. In order to follow the C++ ABI, entities of
+--       primitives that come from source must be stored in this list in the
+--       order of their occurrence in the sources. For incomplete types the
 --       list is always empty.
 
 --    Directly_Designated_Type (Node20)
@@ -1048,6 +1047,9 @@ package Einfo is
 --       a class wide type, points to the parent type. For a subprogram or
 --       subprogram type, Etype has the return type of a function or is set
 --       to Standard_Void_Type to represent a procedure.
+--
+--       Note one obscure case: for pragma Default_Storage_Pool (null), the
+--       Etype of the N_Null node is Empty.
 
 --    Exception_Code (Uint22)
 --       Present in exception entitites. Set to zero unless either an
@@ -1663,7 +1665,7 @@ package Einfo is
 --       of a private type declaration or its corresponding full declaration.
 --       This flag is thus preserved when the full and the partial views are
 --       exchanged, to indicate if a full type declaration is a completion.
---       Used for semantic checks in E.4 (18), and elsewhere.
+--       Used for semantic checks in E.4(18) and elsewhere.
 
 --    Has_Qualified_Name (Flag161)
 --       Present in all entities. Set True if the name in the Chars field
@@ -3221,10 +3223,10 @@ package Einfo is
 
 --    Primitive_Operations (synthesized)
 --       Present in concurrent types, tagged record types and subtypes, tagged
---       private types and tagged incomplete types. For concurrent types that
---       have available their Corresponding_Record_Type (CRT) returns the list
---       of Direct_Primitive_Operations of its CRT; otherwise returns No_Elist.
---       For all the other types returns its Direct_Primitive_Operations.
+--       private types and tagged incomplete types. For concurrent types whose
+--       Corresponding_Record_Type (CRT) is available, returns the list of
+--       Direct_Primitive_Operations of its CRT; otherwise returns No_Elist.
+--       For all the other types returns the Direct_Primitive_Operations.
 
 --    Prival (Node17)
 --       Present in private components of protected types. Refers to the entity
@@ -3817,11 +3819,11 @@ package Einfo is
    type Entity_Kind is (
 
       E_Void,
-      --  The initial Ekind value for a newly created entity. Also used as
-      --  the Ekind for Standard_Void_Type, a type entity in Standard used
-      --  as a dummy type for the return type of a procedure (the reason we
-      --  create this type is to share the circuits for performing overload
-      --  resolution on calls).
+      --  The initial Ekind value for a newly created entity. Also used as the
+      --  Ekind for Standard_Void_Type, a type entity in Standard used as a
+      --  dummy type for the return type of a procedure (the reason we create
+      --  this type is to share the circuits for performing overload resolution
+      --  on calls).
 
       -------------
       -- Objects --

gcc/ada/freeze.adb

@@ -3846,6 +3846,28 @@ package body Freeze is
 
          elsif Is_Access_Type (E) then
 
+            --  If a pragma Default_Storage_Pool applies, and this type has no
+            --  Storage_Pool or Storage_Size clause (which must have occurred
+            --  before the freezing point), then use the default. This applies
+            --  only to base types.
+
+            if Present (Default_Pool)
+              and then E = Base_Type (E)
+              and then not Has_Storage_Size_Clause (E)
+              and then No (Associated_Storage_Pool (E))
+            then
+               --  Case of pragma Default_Storage_Pool (null)
+
+               if Nkind (Default_Pool) = N_Null then
+                  Set_No_Pool_Assigned (E);
+
+               --  Case of pragma Default_Storage_Pool (storage_pool_NAME)
+
+               else
+                  Set_Associated_Storage_Pool (E, Entity (Default_Pool));
+               end if;
+            end if;
+
             --  Check restriction for standard storage pool
 
             if No (Associated_Storage_Pool (E)) then

gcc/ada/gnat_ugn.texi

@@ -11541,6 +11541,7 @@ recognized by GNAT:
    Convention_Identifier
    Debug_Policy
    Detect_Blocking
+   Default_Storage_Pool
    Discard_Names
    Elaboration_Checks
    Eliminate

gcc/ada/make.adb

@@ -8464,13 +8464,13 @@ package body Make is
             Naming      : Lang_Naming_Data renames Lang.Config.Naming_Data;
             Name        : String (1 .. Source_File_Name'Length + 3);
             Last        : Positive := Source_File_Name'Length;
-            Spec_Suffix : constant String :=
-                            Get_Name_String (Naming.Spec_Suffix);
-            Body_Suffix : constant String :=
-                            Get_Name_String (Naming.Body_Suffix);
-            Truncated   : Boolean := False;
+            Spec_Suffix : String   := Get_Name_String (Naming.Spec_Suffix);
+            Body_Suffix : String   := Get_Name_String (Naming.Body_Suffix);
+            Truncated   : Boolean  := False;
 
          begin
+            Canonical_Case_File_Name (Spec_Suffix);
+            Canonical_Case_File_Name (Body_Suffix);
             Name (1 .. Last) := Source_File_Name;
 
             if Last > Body_Suffix'Length

gcc/ada/opt.adb

@@ -50,6 +50,7 @@ package body Opt is
       Assume_No_Invalid_Values_Config       := Assume_No_Invalid_Values;
       Check_Policy_List_Config              := Check_Policy_List;
       Debug_Pragmas_Enabled_Config          := Debug_Pragmas_Enabled;
+      Default_Pool_Config                   := Default_Pool;
       Dynamic_Elaboration_Checks_Config     := Dynamic_Elaboration_Checks;
       Exception_Locations_Suppressed_Config := Exception_Locations_Suppressed;
       Extensions_Allowed_Config             := Extensions_Allowed;
@@ -83,6 +84,7 @@ package body Opt is
       Assume_No_Invalid_Values       := Save.Assume_No_Invalid_Values;
       Check_Policy_List              := Save.Check_Policy_List;
       Debug_Pragmas_Enabled          := Save.Debug_Pragmas_Enabled;
+      Default_Pool                   := Save.Default_Pool;
       Dynamic_Elaboration_Checks     := Save.Dynamic_Elaboration_Checks;
       Exception_Locations_Suppressed := Save.Exception_Locations_Suppressed;
       Extensions_Allowed             := Save.Extensions_Allowed;
@@ -111,6 +113,7 @@ package body Opt is
       Save.Assume_No_Invalid_Values       := Assume_No_Invalid_Values;
       Save.Check_Policy_List              := Check_Policy_List;
       Save.Debug_Pragmas_Enabled          := Debug_Pragmas_Enabled;
+      Save.Default_Pool                   := Default_Pool;
       Save.Dynamic_Elaboration_Checks     := Dynamic_Elaboration_Checks;
       Save.Exception_Locations_Suppressed := Exception_Locations_Suppressed;
       Save.Extensions_Allowed             := Extensions_Allowed;
@@ -192,6 +195,7 @@ package body Opt is
          Use_VADS_Size               := Use_VADS_Size_Config;
       end if;
 
+      Default_Pool                   := Default_Pool_Config;
       Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
       Fast_Math                      := Fast_Math_Config;
       Optimize_Alignment             := Optimize_Alignment_Config;
@@ -227,6 +231,7 @@ package body Opt is
       Tree_Read_Bool (Assertions_Enabled);
       Tree_Read_Int  (Int (Check_Policy_List));
       Tree_Read_Bool (Debug_Pragmas_Enabled);
+      Tree_Read_Int  (Int (Default_Pool));
       Tree_Read_Bool (Enable_Overflow_Checks);
       Tree_Read_Bool (Full_List);
 
@@ -292,6 +297,7 @@ package body Opt is
       Tree_Write_Bool (Assertions_Enabled);
       Tree_Write_Int  (Int (Check_Policy_List));
       Tree_Write_Bool (Debug_Pragmas_Enabled);
+      Tree_Write_Int  (Int (Default_Pool));
       Tree_Write_Bool (Enable_Overflow_Checks);
       Tree_Write_Bool (Full_List);
       Tree_Write_Int  (Int (Version_String'Length));

gcc/ada/opt.ads

@@ -359,6 +359,16 @@ package Opt is
    --  default was set by the binder, and that the default should be the
    --  initial value of System.Secondary_Stack.Default_Secondary_Stack_Size.
 
+   Default_Pool : Node_Id := Empty;
+   --  GNAT
+   --  Used to record the storage pool name (or null literal) that is the
+   --  argument of an applicable pragma Default_Storage_Pool.
+   --    Empty: No pragma Default_Storage_Pool applies.
+   --    N_Null node: "pragma Default_Storage_Pool (null);" applies.
+   --    otherwise: "pragma Default_Storage_Pool (X);" applies, and
+   --    this points to the name X.
+   --  Push_Scope and Pop_Scope in Sem_Ch8 save and restore this.
+
    Detect_Blocking : Boolean := False;
    --  GNAT
    --  Set True to force the run time to raise Program_Error if calls to
@@ -1585,6 +1595,11 @@ package Opt is
    --  mode, as possibly set by the command line switch -gnata and possibly
    --  modified by the use of the configuration pragma Debug_Policy.
 
+   Default_Pool_Config : Node_Id := Empty;
+   --  GNAT
+   --  Same as Default_Pool above, except this is only for Default_Storage_Pool
+   --  pragmas that are configuration pragmas.
+
    Dynamic_Elaboration_Checks_Config : Boolean := False;
    --  GNAT
    --  Set True for dynamic elaboration checking mode, as set by the -gnatE
@@ -1793,6 +1808,7 @@ private
       Assume_No_Invalid_Values       : Boolean;
       Check_Policy_List              : Node_Id;
       Debug_Pragmas_Enabled          : Boolean;
+      Default_Pool                   : Node_Id;
       Dynamic_Elaboration_Checks     : Boolean;
       Exception_Locations_Suppressed : Boolean;
       Extensions_Allowed             : Boolean;

gcc/ada/par-prag.adb

@@ -1129,6 +1129,7 @@ begin
            Pragma_Convention                    |
            Pragma_Debug_Policy                  |
            Pragma_Detect_Blocking               |
+           Pragma_Default_Storage_Pool          |
            Pragma_Dimension                     |
            Pragma_Discard_Names                 |
            Pragma_Eliminate                     |

gcc/ada/sem.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -462,6 +462,9 @@ package Sem is
       Save_Check_Policy_List : Node_Id;
       --  Save contents of Check_Policy_List on entry to restore on exit
 
+      Save_Default_Storage_Pool : Node_Id;
+      --  Save contents of Default_Storage_Pool on entry to restore on exit
+
       Is_Transient : Boolean;
       --  Marks transient scopes (see Exp_Ch7 body for details)
 

gcc/ada/sem_ch8.adb

@@ -6636,18 +6636,36 @@ package body Sem_Ch8 is
 
    procedure Pop_Scope is
       SST : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last);
+      S   : constant Entity_Id := SST.Entity;
 
    begin
       if Debug_Flag_E then
          Write_Info;
       end if;
 
+      --  Set Default_Storage_Pool field of the library unit if necessary
+
+      if Ekind_In (S, E_Package, E_Generic_Package)
+        and then
+          Nkind (Parent (Unit_Declaration_Node (S))) = N_Compilation_Unit
+      then
+         declare
+            Aux : constant Node_Id :=
+              Aux_Decls_Node (Parent (Unit_Declaration_Node (S)));
+         begin
+            if No (Default_Storage_Pool (Aux)) then
+               Set_Default_Storage_Pool (Aux, Default_Pool);
+            end if;
+         end;
+      end if;
+
       Scope_Suppress           := SST.Save_Scope_Suppress;
       Local_Suppress_Stack_Top := SST.Save_Local_Suppress_Stack_Top;
       Check_Policy_List        := SST.Save_Check_Policy_List;
+      Default_Pool             := SST.Save_Default_Storage_Pool;
 
       if Debug_Flag_W then
-         Write_Str ("--> exiting scope: ");
+         Write_Str ("<-- exiting scope: ");
          Write_Name (Chars (Current_Scope));
          Write_Str (", Depth=");
          Write_Int (Int (Scope_Stack.Last));
@@ -6679,7 +6697,7 @@ package body Sem_Ch8 is
    ---------------
 
    procedure Push_Scope (S : Entity_Id) is
-      E : Entity_Id;
+      E : constant Entity_Id := Scope (S);
 
    begin
       if Ekind (S) = E_Void then
@@ -6717,6 +6735,7 @@ package body Sem_Ch8 is
          SST.Save_Scope_Suppress           := Scope_Suppress;
          SST.Save_Local_Suppress_Stack_Top := Local_Suppress_Stack_Top;
          SST.Save_Check_Policy_List        := Check_Policy_List;
+         SST.Save_Default_Storage_Pool     := Default_Pool;
 
          if Scope_Stack.Last > Scope_Stack.First then
             SST.Component_Alignment_Default := Scope_Stack.Table
@@ -6753,8 +6772,6 @@ package body Sem_Ch8 is
         and then Scope (S) /= Standard_Standard
         and then not Is_Child_Unit (S)
       then
-         E := Scope (S);
-
          if Nkind (E) not in N_Entity then
             return;
          end if;
@@ -6776,6 +6793,22 @@ package body Sem_Ch8 is
             Set_Categorization_From_Scope (E => S, Scop => E);
          end if;
       end if;
+
+      if Is_Child_Unit (S)
+        and then Present (E)
+        and then Ekind_In (E, E_Package, E_Generic_Package)
+        and then
+          Nkind (Parent (Unit_Declaration_Node (E))) = N_Compilation_Unit
+      then
+         declare
+            Aux : constant Node_Id :=
+              Aux_Decls_Node (Parent (Unit_Declaration_Node (E)));
+         begin
+            if Present (Default_Storage_Pool (Aux)) then
+               Default_Pool := Default_Storage_Pool (Aux);
+            end if;
+         end;
+      end if;
    end Push_Scope;
 
    ---------------------

gcc/ada/sem_prag.adb

@@ -7112,6 +7112,54 @@ package body Sem_Prag is
             Check_Valid_Configuration_Pragma;
             Detect_Blocking := True;
 
+         --------------------------
+         -- Default_Storage_Pool --
+         --------------------------
+
+         --  pragma Default_Storage_Pool (storage_pool_NAME | null);
+
+         when Pragma_Default_Storage_Pool =>
+            Ada_2012_Pragma;
+            Check_Arg_Count (1);
+
+            --  Default_Storage_Pool can appear as a configuration pragma, or
+            --  in a declarative part or a package spec.
+
+            if not Is_Configuration_Pragma then
+               Check_Is_In_Decl_Part_Or_Package_Spec;
+            end if;
+
+            --  Case of Default_Storage_Pool (null);
+
+            if Nkind (Expression (Arg1)) = N_Null then
+               Analyze (Expression (Arg1));
+               Set_Etype (Expression (Arg1), Empty);
+               --  It's not really an expression, and we have no type for it
+
+            --  Case of Default_Storage_Pool (storage_pool_NAME);
+
+            else
+               --  If it's a configuration pragma, then the only allowed
+               --  argument is "null".
+
+               if Is_Configuration_Pragma then
+                  Error_Pragma_Arg ("NULL expected", Arg1);
+               end if;
+
+               --  The expected type for a non-"null" argument is
+               --  Root_Storage_Pool'Class.
+
+               Analyze_And_Resolve
+                 (Get_Pragma_Arg (Arg1),
+                  Typ => Class_Wide_Type (RTE (RE_Root_Storage_Pool)));
+            end if;
+
+            --  Finally, record the pool name (or null). Freeze.Freeze_Entity
+            --  for an access type will use this information to set the
+            --  appropriate attributes of the access type.
+
+            Default_Pool := Expression (Arg1);
+
          ---------------
          -- Dimension --
          ---------------
@@ -13615,6 +13663,7 @@ package body Sem_Prag is
       Pragma_Debug                         => -1,
       Pragma_Debug_Policy                  =>  0,
       Pragma_Detect_Blocking               => -1,
+      Pragma_Default_Storage_Pool          => -1,
       Pragma_Dimension                     => -1,
       Pragma_Discard_Names                 =>  0,
       Pragma_Elaborate                     => -1,

gcc/ada/sinfo.adb

@@ -707,6 +707,14 @@ package body Sinfo is
       return Node5 (N);
    end Default_Expression;
 
+   function Default_Storage_Pool
+      (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Compilation_Unit_Aux);
+      return Node3 (N);
+   end Default_Storage_Pool;
+
    function Default_Name
       (N : Node_Id) return Node_Id is
    begin
@@ -3694,6 +3702,14 @@ package body Sinfo is
       Set_Node5 (N, Val); -- semantic field, no parent set
    end Set_Default_Expression;
 
+   procedure Set_Default_Storage_Pool
+      (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Compilation_Unit_Aux);
+      Set_Node3 (N, Val); -- semantic field, no parent set
+   end Set_Default_Storage_Pool;
+
    procedure Set_Default_Name
       (N : Node_Id; Val : Node_Id) is
    begin

gcc/ada/sinfo.ads

@@ -59,15 +59,19 @@ package Sinfo is
 
    --  If changes are made to this file, a number of related steps must be
    --  carried out to ensure consistency. First, if a field access function is
-   --  added, it appears in seven places:
-
-   --    The documentation associated with the node
-   --    The spec of the access function in sinfo.ads
-   --    The body of the access function in sinfo.adb
-   --    The pragma Inline at the end of sinfo.ads for the access function
-   --    The spec of the set procedure in sinfo.ads
-   --    The body of the set procedure in sinfo.adb
-   --    The pragma Inline at the end of sinfo.ads for the set procedure
+   --  added, it appears in these places:
+
+   --    In sinfo.ads:
+   --      The documentation associated with the field (if semantic)
+   --      The documentation associated with the node
+   --      The spec of the access function
+   --      The spec of the set procedure
+   --      The entries in Is_Syntactic_Field
+   --      The pragma Inline for the access function
+   --      The pragma Inline for the set procedure
+   --    In sinfo.adb:
+   --      The body of the access function
+   --      The body of the set procedure
 
    --  The field chosen must be consistent in all places, and, for a node that
    --  is a subexpression, must not overlap any of the standard expression
@@ -805,6 +809,12 @@ package Sinfo is
    --    for the default expression). Default_Expression is used for
    --    conformance checking.
 
+   --  Default_Storage_Pool (Node3-Sem)
+   --    This field is present in N_Compilation_Unit_Aux nodes. It is set to a
+   --    copy of Opt.Default_Pool at the end of the compilation unit. See
+   --    package Opt for details. This is used for inheriting the
+   --    Default_Storage_Pool in child units.
+
    --  Discr_Check_Funcs_Built (Flag11-Sem)
    --    This flag is present in N_Full_Type_Declaration nodes. It is set when
    --    discriminant checking functions are constructed. The purpose is to
@@ -5557,8 +5567,8 @@ package Sinfo is
       --  the library item.
 
       --  To deal with all these problems, we create an auxiliary node for
-      --  a compilation unit, referenced from the N_Compilation_Unit node
-      --  that contains these three items.
+      --  a compilation unit, referenced from the N_Compilation_Unit node,
+      --  that contains these items.
 
       --  N_Compilation_Unit
       --  Sloc points to first token of defining unit name
@@ -5580,6 +5590,7 @@ package Sinfo is
       --  Actions (List1) (set to No_List if no actions)
       --  Pragmas_After (List5) pragmas after unit (set to No_List if none)
       --  Config_Pragmas (List4) config pragmas (set to Empty_List if none)
+      --  Default_Storage_Pool (Node3-Sem)
 
       --------------------------
       -- 10.1.1  Library Item --
@@ -8095,6 +8106,9 @@ package Sinfo is
    function Default_Expression
      (N : Node_Id) return Node_Id;    -- Node5
 
+   function Default_Storage_Pool
+     (N : Node_Id) return Node_Id;    -- Node3
+
    function Default_Name
      (N : Node_Id) return Node_Id;    -- Node2
 
@@ -9049,6 +9063,9 @@ package Sinfo is
    procedure Set_Default_Expression
      (N : Node_Id; Val : Node_Id);            -- Node5
 
+   procedure Set_Default_Storage_Pool
+     (N : Node_Id; Val : Node_Id);            -- Node3
+
    procedure Set_Default_Name
      (N : Node_Id; Val : Node_Id);            -- Node2
 
@@ -10984,7 +11001,7 @@ package Sinfo is
      N_Compilation_Unit_Aux =>
        (1 => True,    --  Actions (List1)
         2 => True,    --  Declarations (List2)
-        3 => False,   --  unused
+        3 => False,   --  Default_Storage_Pool (Node3)
         4 => True,    --  Config_Pragmas (List4)
         5 => True),   --  Pragmas_After (List5)
 
@@ -11566,6 +11583,7 @@ package Sinfo is
    pragma Inline (Debug_Statement);
    pragma Inline (Declarations);
    pragma Inline (Default_Expression);
+   pragma Inline (Default_Storage_Pool);
    pragma Inline (Default_Name);
    pragma Inline (Defining_Identifier);
    pragma Inline (Defining_Unit_Name);
@@ -11881,6 +11899,7 @@ package Sinfo is
    pragma Inline (Set_Debug_Statement);
    pragma Inline (Set_Declarations);
    pragma Inline (Set_Default_Expression);
+   pragma Inline (Set_Default_Storage_Pool);
    pragma Inline (Set_Default_Name);
    pragma Inline (Set_Defining_Identifier);
    pragma Inline (Set_Defining_Unit_Name);

gcc/ada/snames.ads-tmpl

@@ -361,6 +361,7 @@ package Snames is
    Name_Convention_Identifier          : constant Name_Id := N + $; -- GNAT
    Name_Debug_Policy                   : constant Name_Id := N + $; -- GNAT
    Name_Detect_Blocking                : constant Name_Id := N + $; -- Ada 05
+   Name_Default_Storage_Pool           : constant Name_Id := N + $; -- Ada 12
    Name_Discard_Names                  : constant Name_Id := N + $;
    Name_Elaboration_Checks             : constant Name_Id := N + $; -- GNAT
    Name_Eliminate                      : constant Name_Id := N + $; -- GNAT
@@ -1463,6 +1464,7 @@ package Snames is
       Pragma_Convention_Identifier,
       Pragma_Debug_Policy,
       Pragma_Detect_Blocking,
+      Pragma_Default_Storage_Pool,
       Pragma_Discard_Names,
       Pragma_Elaboration_Checks,
       Pragma_Eliminate,