@@ -450,6 +450,7 @@ package body Aspects is
Has_Aspect_Specifications_Flag : constant array (Node_Kind) of Boolean :=
(N_Abstract_Subprogram_Declaration => True,
N_Component_Declaration => True,
+ N_Discriminant_Specification => True,
N_Entry_Body => True,
N_Entry_Declaration => True,
N_Exception_Declaration => True,
@@ -471,8 +472,8 @@ package body Aspects is
N_Package_Body_Stub => True,
N_Package_Declaration => True,
N_Package_Instantiation => True,
- N_Package_Specification => True,
N_Package_Renaming_Declaration => True,
+ N_Package_Specification => True,
N_Parameter_Specification => True,
N_Private_Extension_Declaration => True,
N_Private_Type_Declaration => True,
@@ -1375,6 +1375,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Null_Exclusion_Present, Flag, Default_False),
Sy (Discriminant_Type, Node_Id),
Sy (Expression, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (More_Ids, Flag),
Sm (Prev_Ids, Flag)));
@@ -223,7 +223,7 @@ package body Ch12 is
Error_Msg_SP ("child unit allowed only at library level");
end if;
- P_Aspect_Specifications (Gen_Decl);
+ P_Aspect_Specifications (Gen_Decl, Semicolon => True);
end if;
Set_Generic_Formal_Declarations (Gen_Decl, Decls);
@@ -482,7 +482,7 @@ package body Ch12 is
No_Constraint;
Set_Default_Expression (Decl_Node, Init_Expr_Opt);
- P_Aspect_Specifications (Decl_Node);
+ P_Aspect_Specifications (Decl_Node, Semicolon => True);
if Ident > 1 then
Set_Prev_Ids (Decl_Node, True);
@@ -570,7 +570,7 @@ package body Ch12 is
end if;
end if;
- P_Aspect_Specifications (Decl_Node);
+ P_Aspect_Specifications (Decl_Node, Semicolon => True);
else
Decl_Node := Error;
@@ -578,7 +578,7 @@ package body Ch12 is
-- If we have aspect specifications, skip them
if Aspect_Specifications_Present then
- P_Aspect_Specifications (Error);
+ P_Aspect_Specifications (Error, Semicolon => True);
-- If we have semicolon, skip it to avoid cascaded errors
@@ -1250,7 +1250,7 @@ package body Ch12 is
Set_Specification (Def_Node, Spec_Node);
end if;
- P_Aspect_Specifications (Def_Node);
+ P_Aspect_Specifications (Def_Node, Semicolon => True);
return Def_Node;
end P_Formal_Subprogram_Declaration;
@@ -1317,7 +1317,7 @@ package body Ch12 is
end if;
end if;
- P_Aspect_Specifications (Def_Node);
+ P_Aspect_Specifications (Def_Node, Semicolon => True);
return Def_Node;
end P_Formal_Package_Declaration;
@@ -194,20 +194,16 @@ package body Ch13 is
-- Get_Aspect_Specifications --
-------------------------------
- function Get_Aspect_Specifications
- (Semicolon : Boolean := True) return List_Id
- is
+ function Get_Aspect_Specifications (Semicolon : Boolean) return List_Id is
A_Id : Aspect_Id;
Aspect : Node_Id;
- Aspects : List_Id;
+ Aspects : List_Id := Empty_List;
OK : Boolean;
Opt : Boolean;
-- True if current aspect takes an optional argument
begin
- Aspects := Empty_List;
-
-- Check if aspect specification present
if not Aspect_Specifications_Present then
@@ -909,25 +905,13 @@ package body Ch13 is
procedure P_Aspect_Specifications
(Decl : Node_Id;
- Semicolon : Boolean := True)
+ Semicolon : Boolean)
is
- Aspects : List_Id;
- Ptr : Source_Ptr;
+ Ptr : constant Source_Ptr := Token_Ptr;
+ Aspects : constant List_Id := Get_Aspect_Specifications (Semicolon);
begin
- -- Aspect Specification is present
-
- Ptr := Token_Ptr;
-
- -- Here we have an aspect specification to scan, note that we don't
- -- set the flag till later, because it may turn out that we have no
- -- valid aspects in the list.
-
- Aspects := Get_Aspect_Specifications (Semicolon);
-
- -- Here if aspects present
-
- if Is_Non_Empty_List (Aspects) then
+ if Is_Non_Empty_List (Aspects) then -- Aspects present?
-- If Decl is Empty, we just ignore the aspects (the caller in this
-- case has always issued an appropriate error message).
@@ -935,7 +919,7 @@ package body Ch13 is
if Decl = Empty then
null;
- -- If Decl is Error, we ignore the aspects, and issue a message
+ -- Cases where we issue an error
elsif Decl = Error
or else not Permits_Aspect_Specifications (Decl)
@@ -881,7 +881,7 @@ package body Ch3 is
Set_Defining_Identifier (Decl_Node, Ident_Node);
Set_Discriminant_Specifications (Decl_Node, Discr_List);
- P_Aspect_Specifications (Decl_Node);
+ P_Aspect_Specifications (Decl_Node, Semicolon => True);
return Decl_Node;
end P_Type_Declaration;
@@ -930,7 +930,7 @@ package body Ch3 is
Set_Subtype_Indication
(Decl_Node, P_Subtype_Indication (Not_Null_Present));
- P_Aspect_Specifications (Decl_Node);
+ P_Aspect_Specifications (Decl_Node, Semicolon => True);
return Decl_Node;
end P_Subtype_Declaration;
@@ -3270,7 +3270,8 @@ package body Ch3 is
(Specification_Node, Init_Expr_Opt (True));
if Token = Tok_With then
- P_Aspect_Specifications (Specification_Node, False);
+ P_Aspect_Specifications
+ (Specification_Node, Semicolon => False);
end if;
if Ident > 1 then
@@ -3873,8 +3874,9 @@ package body Ch3 is
Set_More_Ids (Decl_Node, True);
end if;
- Append (Decl_Node, Decls);
+ P_Aspect_Specifications (Decl_Node, Semicolon => True);
+ Append (Decl_Node, Decls);
exception
when Error_Resync =>
if Token /= Tok_End then
@@ -3887,8 +3889,6 @@ package body Ch3 is
Restore_Scan_State (Scan_State);
T_Colon;
end loop Ident_Loop;
-
- P_Aspect_Specifications (Decl_Node);
end P_Component_Items;
--------------------------------
@@ -371,7 +371,7 @@ package body Ch6 is
Set_Defining_Unit_Name (Inst_Node, Name_Node);
Set_Generic_Associations (Inst_Node, P_Generic_Actual_Part_Opt);
- P_Aspect_Specifications (Inst_Node);
+ P_Aspect_Specifications (Inst_Node, Semicolon => True);
Pop_Scope_Stack; -- Don't need scope stack entry in this case
if Is_Overriding then
@@ -565,7 +565,7 @@ package body Ch6 is
Scan; -- past RENAMES
Set_Name (Rename_Node, P_Name);
Set_Specification (Rename_Node, Specification_Node);
- P_Aspect_Specifications (Rename_Node);
+ P_Aspect_Specifications (Rename_Node, Semicolon => True);
TF_Semicolon;
Pop_Scope_Stack;
return Rename_Node;
@@ -595,7 +595,7 @@ package body Ch6 is
Set_Specification (Absdec_Node, Specification_Node);
Pop_Scope_Stack; -- discard unneeded entry
Scan; -- past ABSTRACT
- P_Aspect_Specifications (Absdec_Node);
+ P_Aspect_Specifications (Absdec_Node, Semicolon => True);
return Absdec_Node;
-- Ada 2005 (AI-248): Parse a null procedure declaration
@@ -895,7 +895,7 @@ package body Ch6 is
-- Expression functions can carry pre/postconditions
- P_Aspect_Specifications (Body_Node);
+ P_Aspect_Specifications (Body_Node, Semicolon => True);
Pop_Scope_Stack;
-- Subprogram body case
@@ -1624,7 +1624,7 @@ package body Ch6 is
Error_Msg_Ada_2022_Feature
("aspect on formal parameter", Token_Ptr);
- P_Aspect_Specifications (Specification_Node, False);
+ P_Aspect_Specifications (Specification_Node, Semicolon => False);
-- Set the aspect specifications for previous Ids
@@ -1956,7 +1956,7 @@ package body Ch6 is
Set_Return_Object_Declarations (Ret_Node, New_List (Decl));
if Token = Tok_With then
- P_Aspect_Specifications (Decl, False);
+ P_Aspect_Specifications (Decl, Semicolon => False);
end if;
if Token = Tok_Do then
@@ -237,7 +237,7 @@ package body Ch7 is
Move_Aspects (From => Dummy_Node, To => Package_Node);
end if;
- P_Aspect_Specifications (Package_Node);
+ P_Aspect_Specifications (Package_Node, Semicolon => True);
Pop_Scope_Stack;
-- Case of package declaration or package specification
@@ -1029,7 +1029,7 @@ package body Ch9 is
Discard_Junk_Node (P_Expression_No_Right_Paren);
end if;
- P_Aspect_Specifications (Decl_Node);
+ P_Aspect_Specifications (Decl_Node, Semicolon => True);
return Decl_Node;
exception
@@ -1318,7 +1318,7 @@ package body Ch9 is
(Iterator_Node, P_Discrete_Subtype_Definition);
if Token = Tok_With then
- P_Aspect_Specifications (Iterator_Node, False);
+ P_Aspect_Specifications (Iterator_Node, Semicolon => False);
end if;
return Iterator_Node;
@@ -413,18 +413,18 @@ package body Endh is
("misplaced aspects for package declaration");
Error_Msg
("info: aspect specifications belong here??", Is_Loc);
- P_Aspect_Specifications (Empty);
+ P_Aspect_Specifications (Empty, Semicolon => True);
-- Other cases where aspect specifications are not allowed
else
- P_Aspect_Specifications (Error);
+ P_Aspect_Specifications (Error, Semicolon => True);
end if;
-- Aspect specifications allowed
else
- P_Aspect_Specifications (Decl);
+ P_Aspect_Specifications (Decl, Semicolon => True);
end if;
-- If no aspect specifications, must have a semicolon
@@ -1031,11 +1031,11 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
procedure P_Aspect_Specifications
(Decl : Node_Id;
- Semicolon : Boolean := True);
+ Semicolon : Boolean);
-- This procedure scans out a series of aspect specifications. 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.
+ -- argument Semicolon is True, a terminating semicolon is also scanned;
+ -- if False, the scan pointer is left pointing past the aspects and the
+ -- caller must check for a proper terminator.
--
-- P_Aspect_Specifications is called with the current token pointing
-- to either a WITH keyword starting an aspect specification, or an
@@ -1049,14 +1049,14 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
-- semicolon (with the exception that it detects WHEN used in place of
-- WITH).
- -- If Decl is Error on entry, any scanned aspect specifications are
- -- ignored and a message is output saying aspect specifications not
- -- permitted here. If Decl is Empty, then scanned aspect specifications
- -- are also ignored, but no error message is given (this is used when
- -- the caller has already taken care of the error message).
+ -- If Decl is Error or a node that does not allow aspect specifications,
+ -- then any scanned aspect specifications are ignored and a message is
+ -- output saying aspect specifications not permitted here. If Decl is
+ -- Empty, then scanned aspect specifications are also ignored, but no
+ -- error message is given (this is used when the caller has already
+ -- taken care of the error message).
- function Get_Aspect_Specifications
- (Semicolon : Boolean := True) return List_Id;
+ function Get_Aspect_Specifications (Semicolon : Boolean) return List_Id;
-- Parse a list of aspects but do not attach them to a declaration node.
-- Subsidiary to P_Aspect_Specifications procedure. Used when parsing
-- a subprogram specification that may be a declaration or a body.
From: Bob Duff <duff@adacore.com> This patch fixes a bug where aspect specifications were ignored on all but the last of multiple component declarations. For example, in a record type with components "X, Y: T with Volatile;" only Y was marked Volatile; X was not. Both should be marked Volatile. The fix is in Par.Ch3.P_Component_Items, where P_Aspect_Specifications needs to be called each time through the loop. In addition, various minor cleanups. gcc/ada/ * par-ch3.adb (P_Component_Items): Move P_Aspect_Specifications into the loop, so aspects can be attached to multiple component declarations. (P_Type_Declaration, P_Subtype_Declaration) (P_Known_Discriminant_Part_Opt): Remove default for Semicolon in calls to P_Aspect_Specifications. * gen_il-gen-gen_nodes.adb (N_Discriminant_Specification): Add Aspect_Specifications field to N_Discriminant_Specification, which was missing. * aspects.adb (Has_Aspect_Specifications_Flag): Make it True for N_Discriminant_Specification. * par-ch13.adb: Remove default for Semicolon in calls to P_Aspect_Specifications. (Get_Aspect_Specifications): Misc cleanup. (P_Aspect_Specifications): Remove comment. It's not clear what "the flag" is referring to, but anyway the first part of the comment is obvious, and the second part is apparently obsolete. Misc cleanup. * par.adb (P_Aspect_Specifications, Get_Aspect_Specifications): Remove default for Semicolon; calls are more readable that way. Improve comments. * par-ch12.adb: Remove default for Semicolon in calls to P_Aspect_Specifications. * par-ch6.adb: Likewise. * par-ch7.adb: Likewise. * par-ch9.adb: Likewise. * par-endh.adb: Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/aspects.adb | 3 ++- gcc/ada/gen_il-gen-gen_nodes.adb | 1 + gcc/ada/par-ch12.adb | 12 ++++++------ gcc/ada/par-ch13.adb | 30 +++++++----------------------- gcc/ada/par-ch3.adb | 12 ++++++------ gcc/ada/par-ch6.adb | 12 ++++++------ gcc/ada/par-ch7.adb | 2 +- gcc/ada/par-ch9.adb | 4 ++-- gcc/ada/par-endh.adb | 6 +++--- gcc/ada/par.adb | 22 +++++++++++----------- 10 files changed, 45 insertions(+), 59 deletions(-)