[multiple changes]
2011-08-01 Robert Dewar <dewar@adacore.com> * par-endh.adb: Minor reformatting. 2011-08-01 Robert Dewar <dewar@adacore.com> * aspects.ads, aspects.adb: Add aspects for library unit pragmas (Pre_Post_Aspects): New subtype. * par-ch12.adb (P_Generic): New syntax for aspects in packages * par-ch13.adb (P_Aspect_Specifications): Add Semicolon parameter * par-ch7.adb (P_Package): Remove Decl parameter (P_Package): Handle new syntax for aspects (before IS) * par-ch9.adb (P_Protected_Definition): Remove Decl parameter, handle new aspect syntax (P_Task_Definition): Remove Decl parameter, handle new aspect syntax * par.adb (P_Aspect_Specifications): Add Semicolon parameter (P_Package): Remove Decl parameter * sem_ch13.adb (Analyze_Aspect_Specifications): Handle library unit aspects * sem_ch7.adb (Analyze_Package_Declaration): Analyze new format aspect specs * sem_util.ads, sem_util.adb (Static_Boolean): New function * sinfo.ads: Document new syntax for aspects in packages etc. * sprint.adb: Handle new syntax of aspects before IS in package 2011-08-01 Thomas Quinot <quinot@adacore.com> * atree.ads: Minor reformatting. * sem_prag.adb: Minor reformatting. 2011-08-01 Robert Dewar <dewar@adacore.com> * exp_util.adb (Insert_Actions): Fix error in handling Actions for case expr alternative. 2011-08-01 Ed Schonberg <schonberg@adacore.com> * sem_ch12.adb: Fix typo. From-SVN: r177027
This commit is contained in:
parent
9eea4346af
commit
1c54829e23
|
@ -1,3 +1,42 @@
|
|||
2011-08-01 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* par-endh.adb: Minor reformatting.
|
||||
|
||||
2011-08-01 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* aspects.ads, aspects.adb: Add aspects for library unit pragmas
|
||||
(Pre_Post_Aspects): New subtype.
|
||||
* par-ch12.adb (P_Generic): New syntax for aspects in packages
|
||||
* par-ch13.adb (P_Aspect_Specifications): Add Semicolon parameter
|
||||
* par-ch7.adb (P_Package): Remove Decl parameter
|
||||
(P_Package): Handle new syntax for aspects (before IS)
|
||||
* par-ch9.adb (P_Protected_Definition): Remove Decl parameter, handle
|
||||
new aspect syntax
|
||||
(P_Task_Definition): Remove Decl parameter, handle new aspect syntax
|
||||
* par.adb (P_Aspect_Specifications): Add Semicolon parameter
|
||||
(P_Package): Remove Decl parameter
|
||||
* sem_ch13.adb (Analyze_Aspect_Specifications): Handle library unit
|
||||
aspects
|
||||
* sem_ch7.adb (Analyze_Package_Declaration): Analyze new format aspect
|
||||
specs
|
||||
* sem_util.ads, sem_util.adb (Static_Boolean): New function
|
||||
* sinfo.ads: Document new syntax for aspects in packages etc.
|
||||
* sprint.adb: Handle new syntax of aspects before IS in package
|
||||
|
||||
2011-08-01 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* atree.ads: Minor reformatting.
|
||||
* sem_prag.adb: Minor reformatting.
|
||||
|
||||
2011-08-01 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* exp_util.adb (Insert_Actions): Fix error in handling Actions for
|
||||
case expr alternative.
|
||||
|
||||
2011-08-01 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch12.adb: Fix typo.
|
||||
|
||||
2011-08-01 Geert Bosch <bosch@adacore.com>
|
||||
|
||||
* sem_prag.adb (Check_No_Link_Name): New procedure.
|
||||
|
|
|
@ -143,14 +143,18 @@ package body Aspects is
|
|||
N_Object_Declaration => True,
|
||||
N_Package_Declaration => True,
|
||||
N_Package_Instantiation => True,
|
||||
N_Package_Specification => True,
|
||||
N_Private_Extension_Declaration => True,
|
||||
N_Private_Type_Declaration => True,
|
||||
N_Procedure_Instantiation => True,
|
||||
N_Protected_Body => True,
|
||||
N_Protected_Type_Declaration => True,
|
||||
N_Single_Protected_Declaration => True,
|
||||
N_Single_Task_Declaration => True,
|
||||
N_Subprogram_Body => True,
|
||||
N_Subprogram_Declaration => True,
|
||||
N_Subtype_Declaration => True,
|
||||
N_Task_Body => True,
|
||||
N_Task_Type_Declaration => True,
|
||||
others => False);
|
||||
|
||||
|
@ -165,8 +169,8 @@ package body Aspects is
|
|||
|
||||
-- Table used for Same_Aspect, maps aspect to canonical aspect
|
||||
|
||||
Canonical_Aspect : constant array (Aspect_Id) of Aspect_Id := (
|
||||
No_Aspect => No_Aspect,
|
||||
Canonical_Aspect : constant array (Aspect_Id) of Aspect_Id :=
|
||||
(No_Aspect => No_Aspect,
|
||||
Aspect_Ada_2005 => Aspect_Ada_2005,
|
||||
Aspect_Ada_2012 => Aspect_Ada_2005,
|
||||
Aspect_Address => Aspect_Address,
|
||||
|
@ -181,6 +185,17 @@ package body Aspects is
|
|||
Aspect_Favor_Top_Level => Aspect_Favor_Top_Level,
|
||||
Aspect_Inline => Aspect_Inline,
|
||||
Aspect_Inline_Always => Aspect_Inline,
|
||||
Aspect_All_Calls_Remote => Aspect_All_Calls_Remote,
|
||||
Aspect_Compiler_Unit => Aspect_Compiler_Unit,
|
||||
Aspect_Elaborate_Body => Aspect_Elaborate_Body,
|
||||
Aspect_Preelaborate => Aspect_Preelaborate,
|
||||
Aspect_Preelaborate_05 => Aspect_Preelaborate_05,
|
||||
Aspect_Pure => Aspect_Pure,
|
||||
Aspect_Pure_05 => Aspect_Pure_05,
|
||||
Aspect_Remote_Call_Interface => Aspect_Remote_Call_Interface,
|
||||
Aspect_Remote_Types => Aspect_Remote_Types,
|
||||
Aspect_Shared_Passive => Aspect_Shared_Passive,
|
||||
Aspect_Universal_Data => Aspect_Universal_Data,
|
||||
Aspect_Input => Aspect_Input,
|
||||
Aspect_Invariant => Aspect_Invariant,
|
||||
Aspect_Machine_Radix => Aspect_Machine_Radix,
|
||||
|
|
|
@ -73,9 +73,24 @@ package Aspects is
|
|||
Aspect_Warnings,
|
||||
Aspect_Write,
|
||||
|
||||
-- The following aspects correspond to library unit pragmas
|
||||
|
||||
Aspect_All_Calls_Remote,
|
||||
Aspect_Compiler_Unit, -- GNAT
|
||||
Aspect_Elaborate_Body,
|
||||
Aspect_Preelaborate,
|
||||
Aspect_Preelaborate_05, -- GNAT
|
||||
Aspect_Pure,
|
||||
Aspect_Pure_05, -- GNAT
|
||||
Aspect_Remote_Call_Interface,
|
||||
Aspect_Remote_Types,
|
||||
Aspect_Shared_Passive,
|
||||
Aspect_Universal_Data, -- GNAT
|
||||
|
||||
-- Remaining aspects have a static boolean value that turns the aspect
|
||||
-- on or off. They all correspond to pragmas, and the flag Aspect_Cancel
|
||||
-- is set on the pragma if the corresponding aspect is False.
|
||||
-- is set on the pragma if the corresponding aspect is False. These are
|
||||
-- also Boolean aspects as defined below.
|
||||
|
||||
Aspect_Ada_2005, -- GNAT
|
||||
Aspect_Ada_2012, -- GNAT
|
||||
|
@ -109,6 +124,14 @@ package Aspects is
|
|||
Aspect_Post => True,
|
||||
others => False);
|
||||
|
||||
-- The following subtype defines aspects corresponding to library unit
|
||||
-- pragmas, these can only validly appear as aspects for library units,
|
||||
-- and result in a corresponding pragma being inserted immediately after
|
||||
-- the occurrence of the aspect.
|
||||
|
||||
subtype Library_Unit_Aspects is
|
||||
Aspect_Id range Aspect_All_Calls_Remote .. Aspect_Universal_Data;
|
||||
|
||||
-- The following subtype defines aspects accepting an optional static
|
||||
-- boolean parameter indicating if the aspect should be active or
|
||||
-- cancelling. If the parameter is missing the effective value is True,
|
||||
|
@ -119,6 +142,9 @@ package Aspects is
|
|||
subtype Boolean_Aspects is
|
||||
Aspect_Id range Aspect_Ada_2005 .. Aspect_Id'Last;
|
||||
|
||||
subtype Pre_Post_Aspects is
|
||||
Aspect_Id range Aspect_Post .. Aspect_Precondition;
|
||||
|
||||
-- The following type is used for indicating allowed expression forms
|
||||
|
||||
type Aspect_Expression is
|
||||
|
@ -158,6 +184,8 @@ package Aspects is
|
|||
Aspect_Value_Size => Expression,
|
||||
Aspect_Warnings => Name,
|
||||
Aspect_Write => Name,
|
||||
|
||||
Library_Unit_Aspects => Optional,
|
||||
Boolean_Aspects => Optional);
|
||||
|
||||
-----------------------------------------
|
||||
|
@ -176,12 +204,15 @@ package Aspects is
|
|||
(Name_Ada_2012, Aspect_Ada_2012),
|
||||
(Name_Address, Aspect_Address),
|
||||
(Name_Alignment, Aspect_Alignment),
|
||||
(Name_All_Calls_Remote, Aspect_All_Calls_Remote),
|
||||
(Name_Atomic, Aspect_Atomic),
|
||||
(Name_Atomic_Components, Aspect_Atomic_Components),
|
||||
(Name_Bit_Order, Aspect_Bit_Order),
|
||||
(Name_Compiler_Unit, Aspect_Compiler_Unit),
|
||||
(Name_Component_Size, Aspect_Component_Size),
|
||||
(Name_Dynamic_Predicate, Aspect_Dynamic_Predicate),
|
||||
(Name_Discard_Names, Aspect_Discard_Names),
|
||||
(Name_Dynamic_Predicate, Aspect_Dynamic_Predicate),
|
||||
(Name_Elaborate_Body, Aspect_Elaborate_Body),
|
||||
(Name_External_Tag, Aspect_External_Tag),
|
||||
(Name_Favor_Top_Level, Aspect_Favor_Top_Level),
|
||||
(Name_Inline, Aspect_Inline),
|
||||
|
@ -199,9 +230,16 @@ package Aspects is
|
|||
(Name_Precondition, Aspect_Precondition),
|
||||
(Name_Predicate, Aspect_Predicate),
|
||||
(Name_Preelaborable_Initialization, Aspect_Preelaborable_Initialization),
|
||||
(Name_Preelaborate, Aspect_Preelaborate),
|
||||
(Name_Preelaborate_05, Aspect_Preelaborate_05),
|
||||
(Name_Pure, Aspect_Pure),
|
||||
(Name_Pure_05, Aspect_Pure_05),
|
||||
(Name_Pure_Function, Aspect_Pure_Function),
|
||||
(Name_Read, Aspect_Read),
|
||||
(Name_Remote_Call_Interface, Aspect_Remote_Call_Interface),
|
||||
(Name_Remote_Types, Aspect_Remote_Types),
|
||||
(Name_Shared, Aspect_Shared),
|
||||
(Name_Shared_Passive, Aspect_Shared_Passive),
|
||||
(Name_Size, Aspect_Size),
|
||||
(Name_Static_Predicate, Aspect_Static_Predicate),
|
||||
(Name_Storage_Pool, Aspect_Storage_Pool),
|
||||
|
@ -212,6 +250,7 @@ package Aspects is
|
|||
(Name_Type_Invariant, Aspect_Type_Invariant),
|
||||
(Name_Unchecked_Union, Aspect_Unchecked_Union),
|
||||
(Name_Universal_Aliasing, Aspect_Universal_Aliasing),
|
||||
(Name_Universal_Data, Aspect_Universal_Data),
|
||||
(Name_Unmodified, Aspect_Unmodified),
|
||||
(Name_Unreferenced, Aspect_Unreferenced),
|
||||
(Name_Unreferenced_Objects, Aspect_Unreferenced_Objects),
|
||||
|
|
|
@ -821,7 +821,7 @@ package Atree is
|
|||
pragma Inline (Is_Rewrite_Insertion);
|
||||
-- Tests whether the given node was marked using Mark_Rewrite_Insertion.
|
||||
-- This is used in reconstructing the original tree (where such nodes are
|
||||
-- to be eliminated from the reconstructed tree).
|
||||
-- to be eliminated).
|
||||
|
||||
procedure Rewrite (Old_Node, New_Node : Node_Id);
|
||||
-- This is used when a complete subtree is to be replaced. Old_Node is the
|
||||
|
@ -889,8 +889,8 @@ package Atree is
|
|||
|
||||
package Unchecked_Access is
|
||||
|
||||
-- Functions to allow interpretation of Union_Id values as Uint
|
||||
-- and Ureal values
|
||||
-- Functions to allow interpretation of Union_Id values as Uint and
|
||||
-- Ureal values
|
||||
|
||||
function To_Union is new Unchecked_Conversion (Uint, Union_Id);
|
||||
function To_Union is new Unchecked_Conversion (Ureal, Union_Id);
|
||||
|
@ -898,8 +898,8 @@ package Atree is
|
|||
function From_Union is new Unchecked_Conversion (Union_Id, Uint);
|
||||
function From_Union is new Unchecked_Conversion (Union_Id, Ureal);
|
||||
|
||||
-- Functions to fetch contents of indicated field. It is an error
|
||||
-- to attempt to read the value of a field which is not present.
|
||||
-- Functions to fetch contents of indicated field. It is an error to
|
||||
-- attempt to read the value of a field which is not present.
|
||||
|
||||
function Field1 (N : Node_Id) return Union_Id;
|
||||
pragma Inline (Field1);
|
||||
|
@ -1150,10 +1150,10 @@ package Atree is
|
|||
function Str3 (N : Node_Id) return String_Id;
|
||||
pragma Inline (Str3);
|
||||
|
||||
-- Note: the following Uintnn functions have a special test for
|
||||
-- the Field value being Empty. If an Empty value is found then
|
||||
-- Uint_0 is returned. This avoids the rather tricky requirement
|
||||
-- of initializing all Uint fields in nodes and entities.
|
||||
-- Note: the following Uintnn functions have a special test for the
|
||||
-- Field value being Empty. If an Empty value is found then Uint_0 is
|
||||
-- returned. This avoids the rather tricky requirement of initializing
|
||||
-- all Uint fields in nodes and entities.
|
||||
|
||||
function Uint2 (N : Node_Id) return Uint;
|
||||
pragma Inline (Uint2);
|
||||
|
@ -3023,8 +3023,8 @@ package Atree is
|
|||
procedure Set_Flag254 (N : Node_Id; Val : Boolean);
|
||||
pragma Inline (Set_Flag254);
|
||||
|
||||
-- The following versions of Set_Noden also set the parent
|
||||
-- pointer of the referenced node if it is non_Empty
|
||||
-- The following versions of Set_Noden also set the parent pointer of
|
||||
-- the referenced node if it is not Empty.
|
||||
|
||||
procedure Set_Node1_With_Parent (N : Node_Id; Val : Node_Id);
|
||||
pragma Inline (Set_Node1_With_Parent);
|
||||
|
@ -3042,8 +3042,7 @@ package Atree is
|
|||
pragma Inline (Set_Node5_With_Parent);
|
||||
|
||||
-- The following versions of Set_Listn also set the parent pointer of
|
||||
-- the referenced node if it is non_Empty. The procedures for List6
|
||||
-- to List12 can only be applied to nodes which have an extension.
|
||||
-- the referenced node if it is not Empty.
|
||||
|
||||
procedure Set_List1_With_Parent (N : Node_Id; Val : List_Id);
|
||||
pragma Inline (Set_List1_With_Parent);
|
||||
|
|
|
@ -2520,7 +2520,7 @@ package body Exp_Util is
|
|||
(Last (Actions (P)), Ins_Actions);
|
||||
else
|
||||
Set_Actions (P, Ins_Actions);
|
||||
Analyze_List (Then_Actions (P));
|
||||
Analyze_List (Actions (P));
|
||||
end if;
|
||||
|
||||
return;
|
||||
|
|
|
@ -202,7 +202,7 @@ package body Ch12 is
|
|||
|
||||
if Token = Tok_Package then
|
||||
Gen_Decl := New_Node (N_Generic_Package_Declaration, Gen_Sloc);
|
||||
Set_Specification (Gen_Decl, P_Package (Pf_Spcn, Gen_Decl));
|
||||
Set_Specification (Gen_Decl, P_Package (Pf_Spcn));
|
||||
|
||||
else
|
||||
Gen_Decl := New_Node (N_Generic_Subprogram_Declaration, Gen_Sloc);
|
||||
|
|
|
@ -381,7 +381,10 @@ package body Ch13 is
|
|||
|
||||
-- Error recovery: cannot raise Error_Resync
|
||||
|
||||
procedure P_Aspect_Specifications (Decl : Node_Id) is
|
||||
procedure P_Aspect_Specifications
|
||||
(Decl : Node_Id;
|
||||
Semicolon : Boolean := True)
|
||||
is
|
||||
Aspects : List_Id;
|
||||
Aspect : Node_Id;
|
||||
A_Id : Aspect_Id;
|
||||
|
@ -392,7 +395,10 @@ package body Ch13 is
|
|||
-- Check if aspect specification present
|
||||
|
||||
if not Aspect_Specifications_Present then
|
||||
if Semicolon then
|
||||
TF_Semicolon;
|
||||
end if;
|
||||
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
@ -411,7 +417,11 @@ package body Ch13 is
|
|||
|
||||
if Token /= Tok_Identifier then
|
||||
Error_Msg_SC ("aspect identifier expected");
|
||||
|
||||
if Semicolon then
|
||||
Resync_Past_Semicolon;
|
||||
end if;
|
||||
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
@ -454,7 +464,10 @@ package body Ch13 is
|
|||
OK := False;
|
||||
|
||||
else
|
||||
if Semicolon then
|
||||
Resync_Past_Semicolon;
|
||||
end if;
|
||||
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
@ -495,7 +508,10 @@ package body Ch13 is
|
|||
|
||||
-- Test case of missing aspect definition
|
||||
|
||||
if Token = Tok_Comma or else Token = Tok_Semicolon then
|
||||
if Token = Tok_Comma
|
||||
or else Token = Tok_Semicolon
|
||||
or else (not Semicolon and then Token /= Tok_Arrow)
|
||||
then
|
||||
if Aspect_Argument (A_Id) /= Optional then
|
||||
Error_Msg_Node_1 := Aspect;
|
||||
Error_Msg_AP ("aspect& requires an aspect definition");
|
||||
|
@ -527,8 +543,14 @@ package body Ch13 is
|
|||
|
||||
if Token = Tok_Comma then
|
||||
Scan; -- past comma
|
||||
|
||||
-- Must be terminator character
|
||||
|
||||
else
|
||||
if Semicolon then
|
||||
T_Semicolon;
|
||||
end if;
|
||||
|
||||
exit;
|
||||
end if;
|
||||
end if;
|
||||
|
|
|
@ -92,15 +92,17 @@ package body Ch7 is
|
|||
|
||||
-- Error recovery: cannot raise Error_Resync
|
||||
|
||||
function P_Package
|
||||
(Pf_Flags : Pf_Rec;
|
||||
Decl : Node_Id := Empty) return Node_Id
|
||||
is
|
||||
function P_Package (Pf_Flags : Pf_Rec) return Node_Id is
|
||||
Package_Node : Node_Id;
|
||||
Specification_Node : Node_Id;
|
||||
Name_Node : Node_Id;
|
||||
Package_Sloc : Source_Ptr;
|
||||
|
||||
Dummy_Node : constant Node_Id :=
|
||||
New_Node (N_Package_Specification, Token_Ptr);
|
||||
-- Dummy node to attach aspect specifications to until we properly
|
||||
-- figure out where they eventually belong.
|
||||
|
||||
begin
|
||||
Push_Scope_Stack;
|
||||
Scope.Table (Scope.Last).Etyp := E_Name;
|
||||
|
@ -147,8 +149,6 @@ package body Ch7 is
|
|||
Parse_Decls_Begin_End (Package_Node);
|
||||
end if;
|
||||
|
||||
return Package_Node;
|
||||
|
||||
-- Cases other than Package_Body
|
||||
|
||||
else
|
||||
|
@ -174,9 +174,11 @@ package body Ch7 is
|
|||
No_Constraint;
|
||||
TF_Semicolon;
|
||||
Pop_Scope_Stack;
|
||||
return Package_Node;
|
||||
|
||||
-- Generic package instantiation or package declaration
|
||||
|
||||
else
|
||||
P_Aspect_Specifications (Dummy_Node, Semicolon => False);
|
||||
TF_Is;
|
||||
|
||||
-- Case of generic instantiation
|
||||
|
@ -195,7 +197,7 @@ package body Ch7 is
|
|||
Set_Name (Package_Node, P_Qualified_Simple_Name);
|
||||
Set_Generic_Associations
|
||||
(Package_Node, P_Generic_Actual_Part_Opt);
|
||||
P_Aspect_Specifications (Package_Node);
|
||||
P_Aspect_Specifications (Error);
|
||||
Pop_Scope_Stack;
|
||||
|
||||
-- Case of package declaration or package specification
|
||||
|
@ -249,16 +251,13 @@ package body Ch7 is
|
|||
Discard_Junk_List (P_Sequence_Of_Statements (SS_None));
|
||||
end if;
|
||||
|
||||
if Nkind (Package_Node) = N_Package_Declaration then
|
||||
End_Statements (Specification_Node, Package_Node);
|
||||
else
|
||||
End_Statements (Specification_Node, Decl);
|
||||
End_Statements (Specification_Node);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Move_Aspects (From => Dummy_Node, To => Package_Node);
|
||||
return Package_Node;
|
||||
end if;
|
||||
end if;
|
||||
end P_Package;
|
||||
|
||||
------------------------------
|
||||
|
|
|
@ -40,19 +40,11 @@ package body Ch9 is
|
|||
function P_Entry_Body_Formal_Part return Node_Id;
|
||||
function P_Entry_Declaration return Node_Id;
|
||||
function P_Entry_Index_Specification return Node_Id;
|
||||
function P_Protected_Definition return Node_Id;
|
||||
function P_Protected_Operation_Declaration_Opt return Node_Id;
|
||||
function P_Protected_Operation_Items return List_Id;
|
||||
function P_Task_Items return List_Id;
|
||||
|
||||
function P_Protected_Definition (Decl : Node_Id) return Node_Id;
|
||||
-- Parses protected definition and following aspect specifications if
|
||||
-- present. The argument is the declaration node to which the aspect
|
||||
-- specifications are to be attached.
|
||||
|
||||
function P_Task_Definition (Decl : Node_Id) return Node_Id;
|
||||
-- Parses task definition and following aspect specifications if present.
|
||||
-- The argument is the declaration node to which the aspect specifications
|
||||
-- are to be attached.
|
||||
function P_Task_Definition return Node_Id;
|
||||
|
||||
-----------------------------
|
||||
-- 9.1 Task (also 10.1.3) --
|
||||
|
@ -60,13 +52,13 @@ package body Ch9 is
|
|||
|
||||
-- TASK_TYPE_DECLARATION ::=
|
||||
-- task type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
|
||||
-- [is [new INTERFACE_LIST with] TASK_DEFINITION]
|
||||
-- [ASPECT_SPECIFICATIONS];
|
||||
-- [ASPECT_SPECIFICATIONS]
|
||||
-- [is [new INTERFACE_LIST with] TASK_DEFINITION];
|
||||
|
||||
-- SINGLE_TASK_DECLARATION ::=
|
||||
-- task DEFINING_IDENTIFIER
|
||||
-- [is [new INTERFACE_LIST with] TASK_DEFINITION]
|
||||
-- [ASPECT_SPECIFICATIONS];
|
||||
-- [ASPECT_SPECIFICATIONS]
|
||||
-- [is [new INTERFACE_LIST with] TASK_DEFINITION];
|
||||
|
||||
-- TASK_BODY ::=
|
||||
-- task body DEFINING_IDENTIFIER is
|
||||
|
@ -153,27 +145,26 @@ package body Ch9 is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
-- If we have aspect definitions present here, then we do not have
|
||||
-- a task definition present.
|
||||
-- Scan aspect specifications, don't eat the semicolon, since it
|
||||
-- might not be there if we have an IS.
|
||||
|
||||
if Aspect_Specifications_Present then
|
||||
P_Aspect_Specifications (Task_Node);
|
||||
P_Aspect_Specifications (Task_Node, Semicolon => False);
|
||||
|
||||
-- Parse optional task definition. Note that P_Task_Definition scans
|
||||
-- out the semicolon and possible aspect specifications as well as
|
||||
-- the task definition itself.
|
||||
|
||||
elsif Token = Tok_Semicolon then
|
||||
if Token = Tok_Semicolon then
|
||||
|
||||
-- A little check, if the next token after semicolon is
|
||||
-- Entry, then surely the semicolon should really be IS
|
||||
-- A little check, if the next token after semicolon is Entry,
|
||||
-- then surely the semicolon should really be IS
|
||||
|
||||
Scan; -- past semicolon
|
||||
|
||||
if Token = Tok_Entry then
|
||||
Error_Msg_SP -- CODEFIX
|
||||
("|"";"" should be IS");
|
||||
Set_Task_Definition (Task_Node, P_Task_Definition (Task_Node));
|
||||
Set_Task_Definition (Task_Node, P_Task_Definition);
|
||||
else
|
||||
Pop_Scope_Stack; -- Remove unused entry
|
||||
end if;
|
||||
|
@ -214,7 +205,7 @@ package body Ch9 is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
Set_Task_Definition (Task_Node, P_Task_Definition (Task_Node));
|
||||
Set_Task_Definition (Task_Node, P_Task_Definition);
|
||||
end if;
|
||||
|
||||
return Task_Node;
|
||||
|
@ -253,7 +244,7 @@ package body Ch9 is
|
|||
|
||||
-- Error recovery: cannot raise Error_Resync
|
||||
|
||||
function P_Task_Definition (Decl : Node_Id) return Node_Id is
|
||||
function P_Task_Definition return Node_Id is
|
||||
Def_Node : Node_Id;
|
||||
|
||||
begin
|
||||
|
@ -273,7 +264,7 @@ package body Ch9 is
|
|||
end loop;
|
||||
end if;
|
||||
|
||||
End_Statements (Def_Node, Decl);
|
||||
End_Statements (Def_Node);
|
||||
return Def_Node;
|
||||
end P_Task_Definition;
|
||||
|
||||
|
@ -367,13 +358,13 @@ package body Ch9 is
|
|||
|
||||
-- PROTECTED_TYPE_DECLARATION ::=
|
||||
-- protected type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
|
||||
-- is [new INTERFACE_LIST with] PROTECTED_DEFINITION
|
||||
-- [ASPECT_SPECIFICATIONS];
|
||||
-- [ASPECT_SPECIFICATIONS]
|
||||
-- is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
|
||||
|
||||
-- SINGLE_PROTECTED_DECLARATION ::=
|
||||
-- protected DEFINING_IDENTIFIER
|
||||
-- [ASPECT_SPECIFICATIONS]
|
||||
-- is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
|
||||
-- [ASPECT_SPECIFICATIONS];
|
||||
|
||||
-- PROTECTED_BODY ::=
|
||||
-- protected body DEFINING_IDENTIFIER is
|
||||
|
@ -464,6 +455,8 @@ package body Ch9 is
|
|||
Scope.Table (Scope.Last).Labl := Name_Node;
|
||||
end if;
|
||||
|
||||
P_Aspect_Specifications (Protected_Node, Semicolon => False);
|
||||
|
||||
-- Check for semicolon not followed by IS, this is something like
|
||||
|
||||
-- protected type r;
|
||||
|
@ -525,8 +518,7 @@ package body Ch9 is
|
|||
Scan; -- past WITH
|
||||
end if;
|
||||
|
||||
Set_Protected_Definition
|
||||
(Protected_Node, P_Protected_Definition (Protected_Node));
|
||||
Set_Protected_Definition (Protected_Node, P_Protected_Definition);
|
||||
return Protected_Node;
|
||||
end if;
|
||||
end P_Protected;
|
||||
|
@ -561,7 +553,7 @@ package body Ch9 is
|
|||
|
||||
-- Error recovery: cannot raise Error_Resync
|
||||
|
||||
function P_Protected_Definition (Decl : Node_Id) return Node_Id is
|
||||
function P_Protected_Definition return Node_Id is
|
||||
Def_Node : Node_Id;
|
||||
Item_Node : Node_Id;
|
||||
|
||||
|
@ -607,7 +599,7 @@ package body Ch9 is
|
|||
end loop Declaration_Loop;
|
||||
end loop Private_Loop;
|
||||
|
||||
End_Statements (Def_Node, Decl);
|
||||
End_Statements (Def_Node);
|
||||
return Def_Node;
|
||||
end P_Protected_Definition;
|
||||
|
||||
|
|
|
@ -654,7 +654,8 @@ package body Endh is
|
|||
|
||||
procedure End_Statements
|
||||
(Parent : Node_Id := Empty;
|
||||
Decl : Node_Id := Empty) is
|
||||
Decl : Node_Id := Empty)
|
||||
is
|
||||
begin
|
||||
-- This loop runs more than once in the case where Check_End rejects
|
||||
-- the END sequence, as indicated by Check_End returning False.
|
||||
|
|
|
@ -762,14 +762,10 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
|
|||
-------------
|
||||
|
||||
package Ch7 is
|
||||
function P_Package
|
||||
(Pf_Flags : Pf_Rec;
|
||||
Decl : Node_Id := Empty) return Node_Id;
|
||||
function P_Package (Pf_Flags : Pf_Rec) return Node_Id;
|
||||
-- Scans out any construct starting with the keyword PACKAGE. The
|
||||
-- parameter indicates which possible kinds of construct (body, spec,
|
||||
-- instantiation etc.) are permissible in the current context. Decl
|
||||
-- is set in the specification case to request that if there are aspect
|
||||
-- specifications present, they be associated with this declaration.
|
||||
-- instantiation etc.) are permissible in the current context.
|
||||
end Ch7;
|
||||
|
||||
-------------
|
||||
|
@ -863,19 +859,30 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
|
|||
-- rather more generous in considering something ill-formed to be an
|
||||
-- attempt at an aspect specification. The default is more strict for
|
||||
-- Ada versions before Ada 2012 (where aspect specifications are not
|
||||
-- permitted).
|
||||
-- permitted). Note: this routine never checks the terminator token
|
||||
-- for aspects so it does not matter whether the aspect speficiations
|
||||
-- are terminated by semicolon or some other character
|
||||
|
||||
procedure P_Aspect_Specifications (Decl : Node_Id);
|
||||
-- This subprogram is called with the current token pointing to either a
|
||||
-- WITH keyword starting an aspect specification, or a semicolon. In the
|
||||
-- former case, the aspect specifications are scanned out including the
|
||||
-- terminating semicolon, the Has_Aspect_Specifications flag is set in
|
||||
-- the given declaration node, and the list of aspect specifications is
|
||||
-- constructed and associated with this declaration node using a call to
|
||||
-- Set_Aspect_Specifications. If no WITH keyword is present, then this
|
||||
-- call has no effect other than scanning out the semicolon. If Decl is
|
||||
-- Error on entry, any scanned aspect specifications are ignored and a
|
||||
-- message is output saying aspect specifications not permitted here.
|
||||
procedure P_Aspect_Specifications
|
||||
(Decl : Node_Id;
|
||||
Semicolon : Boolean := True);
|
||||
-- This procedure scans out a series of aspect spefications. If argument
|
||||
-- Semicolon is True, a terminating semicolon is also scanned. If this
|
||||
-- argument is False, the scan pointer is left pointing past the aspects
|
||||
-- and the caller must check for a proper terminator.
|
||||
-- left pointing past the aspects, presumably pointing to a terminator.
|
||||
--
|
||||
-- P_Aspect_Specification is called with the current token pointing to
|
||||
-- either a WITH keyword starting an aspect specification, or an
|
||||
-- instance of the terminator token. In the former case, the aspect
|
||||
-- specifications are scanned out including the terminator token if it
|
||||
-- it is a semicolon, and the Has_Aspect_Specifications flag is set in
|
||||
-- the given declaration node. A list of aspects is built and stored for
|
||||
-- this declaration node using a call to Set_Aspect_Specifications. If
|
||||
-- no WITH keyword is present, then this call has no effect other than
|
||||
-- scanning out the terminator if it is a semicolon. If Decl is Error on
|
||||
-- entry, any scanned aspect specifications are ignored and a message is
|
||||
-- output saying aspect specifications not permitted here.
|
||||
|
||||
function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id;
|
||||
-- Function to parse a code statement. The caller has scanned out
|
||||
|
|
|
@ -5501,7 +5501,6 @@ package body Sem_Ch12 is
|
|||
and then Is_Private_Type (Designated_Type (T))
|
||||
and then not Has_Private_View (N)
|
||||
and then Present (Full_View (Designated_Type (T)))
|
||||
and then Used_As_Generic_Actual (T)
|
||||
then
|
||||
Switch_View (Designated_Type (T));
|
||||
|
||||
|
|
|
@ -843,6 +843,47 @@ package body Sem_Ch13 is
|
|||
Set_Is_Delayed_Aspect (Aspect);
|
||||
end if;
|
||||
|
||||
-- Library unit aspects. These are boolean aspects, but we
|
||||
-- always evaluate the expression right away if it is present
|
||||
-- and just ignore the aspect if the expression is False. We
|
||||
-- never delay expression evaluation in this case.
|
||||
|
||||
when Library_Unit_Aspects =>
|
||||
if Present (Expr)
|
||||
and then Is_False (Static_Boolean (Expr))
|
||||
then
|
||||
goto Continue;
|
||||
end if;
|
||||
|
||||
-- Build corresponding pragma node
|
||||
|
||||
Aitem :=
|
||||
Make_Pragma (Loc,
|
||||
Pragma_Argument_Associations => New_List (Ent),
|
||||
Pragma_Identifier =>
|
||||
Make_Identifier (Sloc (Id), Chars (Id)));
|
||||
|
||||
-- This requires special handling in the case of a package
|
||||
-- declaration, the pragma needs to be inserted in the list
|
||||
-- of declarations for the associated package. There is no
|
||||
-- issue of visibility delay for these aspects.
|
||||
|
||||
if Nkind (N) = N_Package_Declaration then
|
||||
if Nkind (Parent (N)) /= N_Compilation_Unit then
|
||||
Error_Msg_N
|
||||
("incorrect context for library unit aspect&", Id);
|
||||
else
|
||||
Prepend
|
||||
(Aitem, Visible_Declarations (Specification (N)));
|
||||
end if;
|
||||
|
||||
goto Continue;
|
||||
end if;
|
||||
|
||||
-- If not package declaration, no delay is required
|
||||
|
||||
Delay_Required := False;
|
||||
|
||||
-- Aspects corresponding to attribute definition clauses
|
||||
|
||||
when Aspect_Address |
|
||||
|
@ -932,11 +973,7 @@ package body Sem_Ch13 is
|
|||
-- required pragma placement. The processing for the pragmas
|
||||
-- takes care of the required delay.
|
||||
|
||||
when Aspect_Pre |
|
||||
Aspect_Precondition |
|
||||
Aspect_Post |
|
||||
Aspect_Postcondition =>
|
||||
declare
|
||||
when Pre_Post_Aspects => declare
|
||||
Pname : Name_Id;
|
||||
|
||||
begin
|
||||
|
@ -1114,15 +1151,38 @@ package body Sem_Ch13 is
|
|||
|
||||
-- If no delay required, insert the pragma/clause in the tree
|
||||
|
||||
else
|
||||
-- If this is a compilation unit, we will put the pragma in
|
||||
-- the Pragmas_After list of the N_Compilation_Unit_Aux node.
|
||||
|
||||
if Nkind (Parent (Ins_Node)) = N_Compilation_Unit then
|
||||
declare
|
||||
Aux : constant Node_Id :=
|
||||
Aux_Decls_Node (Parent (Ins_Node));
|
||||
|
||||
begin
|
||||
pragma Assert (Nkind (Aux) = N_Compilation_Unit_Aux);
|
||||
|
||||
if No (Pragmas_After (Aux)) then
|
||||
Set_Pragmas_After (Aux, Empty_List);
|
||||
end if;
|
||||
|
||||
-- For Pre_Post put at start of list, otherwise at end
|
||||
|
||||
if A_Id in Pre_Post_Aspects then
|
||||
Prepend (Aitem, Pragmas_After (Aux));
|
||||
else
|
||||
Append (Aitem, Pragmas_After (Aux));
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- Here if not compilation unit case
|
||||
|
||||
else
|
||||
-- For Pre/Post cases, insert immediately after the entity
|
||||
-- declaration, since that is the required pragma placement.
|
||||
|
||||
if A_Id = Aspect_Pre or else
|
||||
A_Id = Aspect_Post or else
|
||||
A_Id = Aspect_Precondition or else
|
||||
A_Id = Aspect_Postcondition
|
||||
then
|
||||
if A_Id in Pre_Post_Aspects then
|
||||
Insert_After (N, Aitem);
|
||||
|
||||
-- For all other cases, insert in sequence
|
||||
|
@ -1132,6 +1192,7 @@ package body Sem_Ch13 is
|
|||
Ins_Node := Aitem;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
|
||||
<<Continue>>
|
||||
|
@ -5085,6 +5146,11 @@ package body Sem_Ch13 is
|
|||
when No_Aspect =>
|
||||
raise Program_Error;
|
||||
|
||||
-- Library unit aspects should be impossible (never delayed)
|
||||
|
||||
when Library_Unit_Aspects =>
|
||||
raise Program_Error;
|
||||
|
||||
-- Aspects taking an optional boolean argument. Note that we will
|
||||
-- never be called with an empty expression, because such aspects
|
||||
-- never need to be delayed anyway.
|
||||
|
|
|
@ -760,6 +760,11 @@ package body Sem_Ch7 is
|
|||
-- True when this package declaration is not a nested declaration
|
||||
|
||||
begin
|
||||
-- Analye aspect specifications immediately, since we need to recognize
|
||||
-- things like Pure early enough to diagnose violations during analysis.
|
||||
|
||||
Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
|
||||
|
||||
-- Ada 2005 (AI-217): Check if the package has been erroneously named
|
||||
-- in a limited-with clause of its own context. In this case the error
|
||||
-- has been previously notified by Analyze_Context.
|
||||
|
@ -768,7 +773,7 @@ package body Sem_Ch7 is
|
|||
-- package Pkg is ...
|
||||
|
||||
if From_With_Type (Id) then
|
||||
goto Leave;
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Debug_Flag_C then
|
||||
|
@ -842,9 +847,6 @@ package body Sem_Ch7 is
|
|||
Write_Location (Sloc (N));
|
||||
Write_Eol;
|
||||
end if;
|
||||
|
||||
<<Leave>>
|
||||
Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
|
||||
end Analyze_Package_Declaration;
|
||||
|
||||
-----------------------------------
|
||||
|
|
|
@ -11227,6 +11227,38 @@ package body Sem_Util is
|
|||
Set_Alignment (T1, Alignment (T2));
|
||||
end Set_Size_Info;
|
||||
|
||||
--------------------
|
||||
-- Static_Boolean --
|
||||
--------------------
|
||||
|
||||
function Static_Boolean (N : Node_Id) return Uint is
|
||||
begin
|
||||
Analyze_And_Resolve (N, Standard_Boolean);
|
||||
|
||||
if N = Error
|
||||
or else Error_Posted (N)
|
||||
or else Etype (N) = Any_Type
|
||||
then
|
||||
return No_Uint;
|
||||
end if;
|
||||
|
||||
if Is_Static_Expression (N) then
|
||||
if not Raises_Constraint_Error (N) then
|
||||
return Expr_Value (N);
|
||||
else
|
||||
return No_Uint;
|
||||
end if;
|
||||
|
||||
elsif Etype (N) = Any_Type then
|
||||
return No_Uint;
|
||||
|
||||
else
|
||||
Flag_Non_Static_Expr
|
||||
("static boolean expression required here", N);
|
||||
return No_Uint;
|
||||
end if;
|
||||
end Static_Boolean;
|
||||
|
||||
--------------------
|
||||
-- Static_Integer --
|
||||
--------------------
|
||||
|
|
|
@ -1280,6 +1280,12 @@ package Sem_Util is
|
|||
function Scope_Is_Transient return Boolean;
|
||||
-- True if the current scope is transient
|
||||
|
||||
function Static_Boolean (N : Node_Id) return Uint;
|
||||
-- This function analyzes the given expression node and then resolves it
|
||||
-- as Standard.Boolean. If the result is static, then Uint_1 or Uint_0 is
|
||||
-- returned corresponding to the value, otherwise an error message is
|
||||
-- output and No_Uint is returned.
|
||||
|
||||
function Static_Integer (N : Node_Id) return Uint;
|
||||
-- This function analyzes the given expression node and then resolves it
|
||||
-- as any integer type. If the result is static, then the value of the
|
||||
|
|
|
@ -4773,8 +4773,7 @@ package Sinfo is
|
|||
------------------------------
|
||||
|
||||
-- PACKAGE_DECLARATION ::=
|
||||
-- PACKAGE_SPECIFICATION
|
||||
-- [ASPECT_SPECIFICATIONS];
|
||||
-- PACKAGE_SPECIFICATION;
|
||||
|
||||
-- Note: the activation chain entity for a package spec is used for
|
||||
-- all tasks declared in the package spec, or in the package body.
|
||||
|
@ -4791,7 +4790,9 @@ package Sinfo is
|
|||
--------------------------------
|
||||
|
||||
-- PACKAGE_SPECIFICATION ::=
|
||||
-- package DEFINING_PROGRAM_UNIT_NAME is
|
||||
-- package DEFINING_PROGRAM_UNIT_NAME
|
||||
-- [ASPECT_SPECIFICATIONS]
|
||||
-- is
|
||||
-- {BASIC_DECLARATIVE_ITEM}
|
||||
-- [private
|
||||
-- {BASIC_DECLARATIVE_ITEM}]
|
||||
|
@ -4812,7 +4813,9 @@ package Sinfo is
|
|||
-----------------------
|
||||
|
||||
-- PACKAGE_BODY ::=
|
||||
-- package body DEFINING_PROGRAM_UNIT_NAME is
|
||||
-- package body DEFINING_PROGRAM_UNIT_NAME
|
||||
-- [ASPECT_SPECIFICATIONS]
|
||||
-- is
|
||||
-- DECLARATIVE_PART
|
||||
-- [begin
|
||||
-- HANDLED_SEQUENCE_OF_STATEMENTS]
|
||||
|
@ -5023,8 +5026,8 @@ package Sinfo is
|
|||
|
||||
-- TASK_TYPE_DECLARATION ::=
|
||||
-- task type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
|
||||
-- [is [new INTERFACE_LIST with] TASK_DEFINITION]
|
||||
-- [ASPECT_SPECIFICATIONS];
|
||||
-- [ASPECT_SPECIFICATIONS]
|
||||
-- [is [new INTERFACE_LIST with] TASK_DEFINITION];
|
||||
|
||||
-- N_Task_Type_Declaration
|
||||
-- Sloc points to TASK
|
||||
|
@ -5041,8 +5044,8 @@ package Sinfo is
|
|||
|
||||
-- SINGLE_TASK_DECLARATION ::=
|
||||
-- task DEFINING_IDENTIFIER
|
||||
-- [is [new INTERFACE_LIST with] TASK_DEFINITION]
|
||||
-- [ASPECT_SPECIFICATIONS];
|
||||
-- [ASPECT_SPECIFICATIONS]
|
||||
-- [is [new INTERFACE_LIST with] TASK_DEFINITION];
|
||||
|
||||
-- N_Single_Task_Declaration
|
||||
-- Sloc points to TASK
|
||||
|
@ -5086,7 +5089,9 @@ package Sinfo is
|
|||
--------------------
|
||||
|
||||
-- TASK_BODY ::=
|
||||
-- task body task_DEFINING_IDENTIFIER is
|
||||
-- task body task_DEFINING_IDENTIFIER
|
||||
-- [ASPECT_SPECIFICATIONS]
|
||||
-- is
|
||||
-- DECLARATIVE_PART
|
||||
-- begin
|
||||
-- HANDLED_SEQUENCE_OF_STATEMENTS
|
||||
|
@ -5110,8 +5115,8 @@ package Sinfo is
|
|||
|
||||
-- PROTECTED_TYPE_DECLARATION ::=
|
||||
-- protected type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
|
||||
-- is [new INTERFACE_LIST with] PROTECTED_DEFINITION
|
||||
-- {ASPECT_SPECIFICATIONS];
|
||||
-- [ASPECT_SPECIFICATIONS]
|
||||
-- is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
|
||||
|
||||
-- Note: protected type declarations are not permitted in Ada 83 mode
|
||||
|
||||
|
@ -5130,8 +5135,8 @@ package Sinfo is
|
|||
|
||||
-- SINGLE_PROTECTED_DECLARATION ::=
|
||||
-- protected DEFINING_IDENTIFIER
|
||||
-- is [new INTERFACE_LIST with] PROTECTED_DEFINITION
|
||||
-- [ASPECT_SPECIFICATIONS];
|
||||
-- [ASPECT_SPECIFICATIONS]
|
||||
-- is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
|
||||
|
||||
-- Note: single protected declarations are not allowed in Ada 83 mode
|
||||
|
||||
|
@ -5179,7 +5184,9 @@ package Sinfo is
|
|||
-------------------------
|
||||
|
||||
-- PROTECTED_BODY ::=
|
||||
-- protected body DEFINING_IDENTIFIER is
|
||||
-- protected body DEFINING_IDENTIFIER
|
||||
-- [ASPECT_SPECIFICATIONS];
|
||||
-- is
|
||||
-- {PROTECTED_OPERATION_ITEM}
|
||||
-- end [protected_IDENTIFIER];
|
||||
|
||||
|
|
|
@ -183,11 +183,16 @@ package body Sprint is
|
|||
procedure Sprint_And_List (List : List_Id);
|
||||
-- Print the given list with items separated by vertical "and"
|
||||
|
||||
procedure Sprint_Aspect_Specifications (Node : Node_Id);
|
||||
procedure Sprint_Aspect_Specifications
|
||||
(Node : Node_Id;
|
||||
Semicolon : Boolean);
|
||||
-- Node is a declaration node that has aspect specifications (Has_Aspects
|
||||
-- flag set True). It is called after outputting the terminating semicolon
|
||||
-- for the related node. The effect is to remove the semicolon and print
|
||||
-- the aspect specifications, followed by a terminating semicolon.
|
||||
-- flag set True). It outputs the aspect specifications. For the case
|
||||
-- of Semicolon = True, it is called after outputting the terminating
|
||||
-- semicolon for the related node. The effect is to remove the semicolon
|
||||
-- and print the aspect specifications followed by a terminating semicolon.
|
||||
-- For the case of Semicolon False, no semicolon is removed or output, and
|
||||
-- all the aspects are printed on a single line.
|
||||
|
||||
procedure Sprint_Bar_List (List : List_Id);
|
||||
-- Print the given list with items separated by vertical bars
|
||||
|
@ -630,17 +635,25 @@ package body Sprint is
|
|||
-- Sprint_Aspect_Specifications --
|
||||
----------------------------------
|
||||
|
||||
procedure Sprint_Aspect_Specifications (Node : Node_Id) is
|
||||
procedure Sprint_Aspect_Specifications
|
||||
(Node : Node_Id;
|
||||
Semicolon : Boolean)
|
||||
is
|
||||
AS : constant List_Id := Aspect_Specifications (Node);
|
||||
A : Node_Id;
|
||||
|
||||
begin
|
||||
if Semicolon then
|
||||
Write_Erase_Char (';');
|
||||
Indent := Indent + 2;
|
||||
Write_Indent;
|
||||
Write_Str ("with ");
|
||||
Indent := Indent + 5;
|
||||
|
||||
else
|
||||
Write_Str (" with ");
|
||||
end if;
|
||||
|
||||
A := First (AS);
|
||||
loop
|
||||
Sprint_Node (Identifier (A));
|
||||
|
@ -658,11 +671,16 @@ package body Sprint is
|
|||
|
||||
exit when No (A);
|
||||
Write_Char (',');
|
||||
|
||||
if Semicolon then
|
||||
Write_Indent;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
if Semicolon then
|
||||
Indent := Indent - 7;
|
||||
Write_Char (';');
|
||||
end if;
|
||||
end Sprint_Aspect_Specifications;
|
||||
|
||||
---------------------
|
||||
|
@ -2411,6 +2429,14 @@ package body Sprint is
|
|||
when N_Package_Specification =>
|
||||
Write_Str_With_Col_Check_Sloc ("package ");
|
||||
Sprint_Node (Defining_Unit_Name (Node));
|
||||
|
||||
if Nkind (Parent (Node)) = N_Package_Declaration
|
||||
and then Has_Aspects (Parent (Node))
|
||||
then
|
||||
Sprint_Aspect_Specifications
|
||||
(Parent (Node), Semicolon => False);
|
||||
end if;
|
||||
|
||||
Write_Str (" is");
|
||||
Sprint_Indented_List (Visible_Declarations (Node));
|
||||
|
||||
|
@ -3176,8 +3202,11 @@ package body Sprint is
|
|||
end if;
|
||||
end case;
|
||||
|
||||
if Has_Aspects (Node) then
|
||||
Sprint_Aspect_Specifications (Node);
|
||||
-- Print aspects, except for special case of package declaration,
|
||||
-- where the aspects are printed inside the package specification.
|
||||
|
||||
if Has_Aspects (Node) and Nkind (Node) /= N_Package_Declaration then
|
||||
Sprint_Aspect_Specifications (Node, Semicolon => True);
|
||||
end if;
|
||||
|
||||
if Nkind (Node) in N_Subexpr
|
||||
|
|
Loading…
Reference in New Issue