mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-22 22:51:32 +08:00
[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
This commit is contained in:
parent
6191e21252
commit
fab2daeb32
@ -1,3 +1,35 @@
|
||||
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
|
||||
|
@ -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 --
|
||||
|
@ -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
|
||||
|
@ -11541,6 +11541,7 @@ recognized by GNAT:
|
||||
Convention_Identifier
|
||||
Debug_Policy
|
||||
Detect_Blocking
|
||||
Default_Storage_Pool
|
||||
Discard_Names
|
||||
Elaboration_Checks
|
||||
Eliminate
|
||||
|
@ -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
|
||||
|
@ -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));
|
||||
|
@ -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;
|
||||
|
@ -1129,6 +1129,7 @@ begin
|
||||
Pragma_Convention |
|
||||
Pragma_Debug_Policy |
|
||||
Pragma_Detect_Blocking |
|
||||
Pragma_Default_Storage_Pool |
|
||||
Pragma_Dimension |
|
||||
Pragma_Discard_Names |
|
||||
Pragma_Eliminate |
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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;
|
||||
|
||||
---------------------
|
||||
|
@ -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,
|
||||
|
@ -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
|
||||
|
@ -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:
|
||||
-- added, it appears in these 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
|
||||
-- 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);
|
||||
|
@ -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,
|
||||
|
Loading…
x
Reference in New Issue
Block a user