+2017-01-23 Ed Schonberg <schonberg@adacore.com>
+
+ * par-ch4.adb (P_Aggregate_Or_Parent_Expr): Recognize delta
+ aggregate construct.
+ (P_Record_Or_Array_Component_Association): An array aggregate
+ can start with an Iterated_Component_Association.
+ * scng.adb: Modify error message on improper use of @ in earlier
+ versions of the language.
+ * sinfo.ads: New node kind N_Delta_Aggregate.
+ * sinfo.adb: An N_Delta_Aggregate has component associations and
+ an expression.
+ * sem_res.adb (Resolve): Call Resolve_Delta_Aggregate.
+ * sem_aggr.ads, sem_aggr.adb (Resolve_Iterated_Component_Association):
+ Create a new index for each one of the choices in the association,
+ to prevent spurious homonyms in the scope.
+ (Resolve_Delta_Aggregate): New.
+ * sem.adb: An N_Delta_Aggregate is analyzed like an aggregate.
+ * exp_util.adb (Insert_Actions): Take into account
+ N_Delta_Aggregate.
+ * exp_aggr.ads: New procedure Expand_N_Delta_Aggregate.
+ * exp_aggr.adb: New procedure Expand_N_Delta_Aggregate,
+ and local procedures Expand_Delta_Array_Aggregate and
+ expand_Delta_Record_Aggregate.
+ * sprint.adb: Handle N_Delta_Aggregate.
+
+2017-01-23 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch11.adb (Expand_N_Exception_Declaration): Generate an
+ empty name when the exception declaration is subject to pragma
+ Discard_Names.
+ (Null_String): New routine.
+
+2017-01-23 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * par-ch9.adb (P_Protected_Definition): Parse
+ any optional and potentially illegal pragmas which appear in
+ a protected operation declaration list.
+ (P_Task_Items): Parse
+ any optional and potentially illegal pragmas which appear in a
+ task item list.
+
2017-01-23 Pascal Obry <obry@adacore.com>
* s-taprop-mingw.adb (Enter_Task): Initialize the Thread handle which
-- expression with actions, which becomes the Initialization_Statements for
-- Obj.
+ procedure Expand_Delta_Array_Aggregate (N : Node_Id; Deltas : List_Id);
+ procedure Expand_Delta_Record_Aggregate (N : Node_Id; Deltas : List_Id);
+
function Has_Default_Init_Comps (N : Node_Id) return Boolean;
-- N is an aggregate (record or array). Checks the presence of default
-- initialization (<>) in any component (Ada 2005: AI-287).
return;
end Expand_N_Aggregate;
+ ------------------------------
+ -- Expand_N_Delta_Aggregate --
+ ------------------------------
+
+ procedure Expand_N_Delta_Aggregate (N : Node_Id) is
+ Loc : constant Source_Ptr := Sloc (N);
+ Temp : constant Entity_Id := Make_Temporary (Loc, 'T');
+ Typ : constant Entity_Id := Etype (N);
+ Decl : Node_Id;
+
+ begin
+ Decl := Make_Object_Declaration (Loc,
+ Defining_Identifier => Temp,
+ Object_Definition => New_Occurrence_Of (Typ, Loc),
+ Expression => New_Copy_Tree (Expression (N)));
+
+ if Is_Array_Type (Etype (N)) then
+ Expand_Delta_Array_Aggregate (N, New_List (Decl));
+ else
+ Expand_Delta_Record_Aggregate (N, New_List (Decl));
+ end if;
+ end Expand_N_Delta_Aggregate;
+
+ ----------------------------------
+ -- Expand_Delta_Array_Aggregate --
+ ----------------------------------
+
+ procedure Expand_Delta_Array_Aggregate (N : Node_Id; Deltas : List_Id) is
+ Loc : constant Source_Ptr := Sloc (N);
+ Temp : constant Entity_Id := Defining_Identifier (First (Deltas));
+ Assoc : Node_Id;
+ Choice : Node_Id;
+ function Generate_Loop (C : Node_Id) return Node_Id;
+ -- Generate a loop containing individual component assignments for
+ -- choices that are ranges, subtype indications, subtype names, and
+ -- iterated component associations.
+
+ function Generate_Loop (C : Node_Id) return Node_Id is
+ Sl : constant Source_Ptr := Sloc (C);
+ Ix : Entity_Id;
+
+ begin
+ if Nkind (Parent (C)) = N_Iterated_Component_Association then
+ Ix :=
+ Make_Defining_Identifier (Loc,
+ Chars => (Chars (Defining_Identifier (Parent (C)))));
+ else
+ Ix := Make_Temporary (Sl, 'I');
+ end if;
+
+ return
+ Make_Loop_Statement (Loc,
+ Iteration_Scheme => Make_Iteration_Scheme (Sl,
+ Loop_Parameter_Specification =>
+ Make_Loop_Parameter_Specification (Sl,
+ Defining_Identifier => Ix,
+ Discrete_Subtype_Definition => New_Copy_Tree (C))),
+ End_Label => Empty,
+ Statements =>
+ New_List (
+ Make_Assignment_Statement (Sl,
+ Name => Make_Indexed_Component (Sl,
+ Prefix => New_Occurrence_Of (Temp, Sl),
+ Expressions => New_List (New_Occurrence_Of (Ix, Sl))),
+ Expression => New_Copy_Tree (Expression (Assoc)))));
+ end Generate_Loop;
+
+ begin
+ Assoc := First (Component_Associations (N));
+ while Present (Assoc) loop
+ Choice := First (Choice_List (Assoc));
+ if Nkind (Assoc) = N_Iterated_Component_Association then
+ while Present (Choice) loop
+ Append_To (Deltas, Generate_Loop (Choice));
+ Next (Choice);
+ end loop;
+
+ else
+ while Present (Choice) loop
+
+ -- Choice can be given by a range, a subtype indication, a
+ -- subtype name, a scalar value, or an entity.
+
+ if Nkind (Choice) = N_Range
+ or else (Is_Entity_Name (Choice)
+ and then Is_Type (Entity (Choice)))
+ then
+ Append_To (Deltas, Generate_Loop (Choice));
+
+ elsif Nkind (Choice) = N_Subtype_Indication then
+ Append_To (Deltas,
+ Generate_Loop (Range_Expression (Constraint (Choice))));
+
+ else
+ Append_To (Deltas,
+ Make_Assignment_Statement (Sloc (Choice),
+ Name => Make_Indexed_Component (Sloc (Choice),
+ Prefix => New_Occurrence_Of (Temp, Loc),
+ Expressions => New_List (New_Copy_Tree (Choice))),
+ Expression => New_Copy_Tree (Expression (Assoc))));
+ end if;
+
+ Next (Choice);
+ end loop;
+ end if;
+
+ Next (Assoc);
+ end loop;
+
+ Insert_Actions (N, Deltas);
+ Rewrite (N, New_Occurrence_Of (Temp, Loc));
+ end Expand_Delta_Array_Aggregate;
+
+ -----------------------------------
+ -- Expand_Delta_Record_Aggregate --
+ -----------------------------------
+
+ procedure Expand_Delta_Record_Aggregate (N : Node_Id; Deltas : List_Id) is
+ Loc : constant Source_Ptr := Sloc (N);
+ Temp : constant Entity_Id := Defining_Identifier (First (Deltas));
+ Assoc : Node_Id;
+ Choice : Node_Id;
+
+ begin
+ Assoc := First (Component_Associations (N));
+
+ while Present (Assoc) loop
+ Choice := First (Choice_List (Assoc));
+ while Present (Choice) loop
+ Append_To (Deltas,
+ Make_Assignment_Statement (Sloc (Choice),
+ Name => Make_Selected_Component (Sloc (Choice),
+ Prefix => New_Occurrence_Of (Temp, Loc),
+ Selector_Name => Make_Identifier (Loc, Chars (Choice))),
+ Expression => New_Copy_Tree (Expression (Assoc))));
+ Next (Choice);
+ end loop;
+
+ Next (Assoc);
+ end loop;
+
+ Insert_Actions (N, Deltas);
+ Rewrite (N, New_Occurrence_Of (Temp, Loc));
+ end Expand_Delta_Record_Aggregate;
+
----------------------------------
-- Expand_N_Extension_Aggregate --
----------------------------------
package Exp_Aggr is
procedure Expand_N_Aggregate (N : Node_Id);
+ procedure Expand_N_Delta_Aggregate (N : Node_Id);
procedure Expand_N_Extension_Aggregate (N : Node_Id);
function Is_Delayed_Aggregate (N : Node_Id) return Boolean;
-- end if;
procedure Expand_N_Exception_Declaration (N : Node_Id) is
- Id : constant Entity_Id := Defining_Identifier (N);
- Loc : constant Source_Ptr := Sloc (N);
- Ex_Id : Entity_Id;
- Flag_Id : Entity_Id;
- L : List_Id;
+ Id : constant Entity_Id := Defining_Identifier (N);
+ Loc : constant Source_Ptr := Sloc (N);
procedure Force_Static_Allocation_Of_Referenced_Objects
(Aggregate : Node_Id);
-- references to other local (non-hoisted) objects (e.g., in the initial
-- value expression).
+ function Null_String return String_Id;
+ -- Build a null-terminated empty string
+
---------------------------------------------------
-- Force_Static_Allocation_Of_Referenced_Objects --
---------------------------------------------------
Fixup_Tree (Aggregate);
end Force_Static_Allocation_Of_Referenced_Objects;
+ -----------------
+ -- Null_String --
+ -----------------
+
+ function Null_String return String_Id is
+ begin
+ Start_String;
+ Store_String_Char (Get_Char_Code (ASCII.NUL));
+ return End_String;
+ end Null_String;
+
+ -- Local variables
+
+ Ex_Id : Entity_Id;
+ Ex_Val : String_Id;
+ Flag_Id : Entity_Id;
+ L : List_Id;
+
-- Start of processing for Expand_N_Exception_Declaration
begin
Ex_Id :=
Make_Defining_Identifier (Loc, New_External_Name (Chars (Id), 'E'));
+ -- Do not generate an external name if the exception declaration is
+ -- subject to pragma Discard_Names. Use a null-terminated empty name
+ -- to ensure that Ada.Exceptions.Exception_Name functions properly.
+
+ if Global_Discard_Names or else Discard_Names (Ex_Id) then
+ Ex_Val := Null_String;
+
+ -- Otherwise generate the fully qualified name of the exception
+
+ else
+ Ex_Val := Fully_Qualified_Name_String (Id);
+ end if;
+
Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Ex_Id,
Constant_Present => True,
Object_Definition => New_Occurrence_Of (Standard_String, Loc),
- Expression =>
- Make_String_Literal (Loc,
- Strval => Fully_Qualified_Name_String (Id))));
+ Expression => Make_String_Literal (Loc, Ex_Val)));
Set_Is_Statically_Allocated (Ex_Id);
| N_Defining_Operator_Symbol
| N_Defining_Program_Unit_Name
| N_Delay_Alternative
+ | N_Delta_Aggregate
| N_Delta_Constraint
| N_Derived_Type_Definition
| N_Designator
Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
end if;
- -- Extension aggregate
+ -- Extension or Delta aggregate
if Token = Tok_With then
if Nkind (Expr_Node) = N_Attribute_Reference
Error_Msg_SC ("(Ada 83) extension aggregate not allowed");
end if;
- Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
- Set_Ancestor_Part (Aggregate_Node, Expr_Node);
Scan; -- past WITH
+ if Token = Tok_Delta then
+ Scan; -- past DELTA
+ Aggregate_Node := New_Node (N_Delta_Aggregate, Lparen_Sloc);
+ Set_Expression (Aggregate_Node, Expr_Node);
+ Expr_Node := Empty;
+ goto Aggregate;
+
+ else
+ Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
+ Set_Ancestor_Part (Aggregate_Node, Expr_Node);
+ end if;
-- Deal with WITH NULL RECORD case
-- All component associations (positional and named) have been scanned
T_Right_Paren;
- Set_Expressions (Aggregate_Node, Expr_List);
+
+ if Nkind (Aggregate_Node) /= N_Delta_Aggregate then
+ Set_Expressions (Aggregate_Node, Expr_List);
+ end if;
+
Set_Component_Associations (Aggregate_Node, Assoc_List);
return Aggregate_Node;
end P_Aggregate_Or_Paren_Expr;
Assoc_Node : Node_Id;
begin
+ if Token = Tok_For then
+ return P_Iterated_Component_Association;
+ end if;
+
Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
Set_Choices (Assoc_Node, P_Discrete_Choice_List);
Set_Sloc (Assoc_Node, Token_Ptr);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
Decl_Sloc := Token_Ptr;
if Token = Tok_Pragma then
- Append (P_Pragma, Items);
+ P_Pragmas_Opt (Items);
- -- Ada 2005 (AI-397): Reserved words NOT and OVERRIDING
- -- may begin an entry declaration.
+ -- Ada 2005 (AI-397): Reserved words NOT and OVERRIDING may begin an
+ -- entry declaration.
elsif Token = Tok_Entry
or else Token = Tok_Not
Append (P_Entry_Declaration, Items);
elsif Token = Tok_For then
- -- Representation clause in task declaration. The only rep
- -- clause which is legal in a protected is an address clause,
+
+ -- Representation clause in task declaration. The only rep clause
+ -- which is legal in a protected declaration is an address clause,
-- so that is what we try to scan out.
Item_Node := P_Representation_Clause;
-- Error recovery: cannot raise Error_Resync
function P_Protected_Definition return Node_Id is
- Def_Node : Node_Id;
- Item_Node : Node_Id;
+ Def_Node : Node_Id;
+ Item_Node : Node_Id;
+ Priv_Decls : List_Id;
+ Vis_Decls : List_Id;
begin
Def_Node := New_Node (N_Protected_Definition, Token_Ptr);
-- Loop to scan visible declarations (protected operation declarations)
- Set_Visible_Declarations (Def_Node, New_List);
+ Vis_Decls := New_List;
+ Set_Visible_Declarations (Def_Node, Vis_Decls);
+
+ -- Flag and discard all pragmas which cannot appear in the protected
+ -- definition. Note that certain pragmas are still allowed as long as
+ -- they apply to entries, entry families, or protected subprograms.
+
+ P_Pragmas_Opt (Vis_Decls);
loop
Item_Node := P_Protected_Operation_Declaration_Opt;
+
+ if Present (Item_Node) then
+ Append (Item_Node, Vis_Decls);
+ end if;
+
+ P_Pragmas_Opt (Vis_Decls);
+
exit when No (Item_Node);
- Append (Item_Node, Visible_Declarations (Def_Node));
end loop;
-- Deal with PRIVATE part (including graceful handling of multiple
-- PRIVATE parts).
Private_Loop : while Token = Tok_Private loop
- if No (Private_Declarations (Def_Node)) then
- Set_Private_Declarations (Def_Node, New_List);
- else
+ Priv_Decls := Private_Declarations (Def_Node);
+
+ if Present (Priv_Decls) then
Error_Msg_SC ("duplicate private part");
+ else
+ Priv_Decls := New_List;
+ Set_Private_Declarations (Def_Node, Priv_Decls);
end if;
Scan; -- past PRIVATE
+ -- Flag and discard all pragmas which cannot appear in the protected
+ -- definition. Note that certain pragmas are still allowed as long as
+ -- they apply to entries, entry families, or protected subprograms.
+
+ P_Pragmas_Opt (Priv_Decls);
+
Declaration_Loop : loop
if Token = Tok_Identifier then
- P_Component_Items (Private_Declarations (Def_Node));
+ P_Component_Items (Priv_Decls);
+ P_Pragmas_Opt (Priv_Decls);
+
else
Item_Node := P_Protected_Operation_Declaration_Opt;
+
+ if Present (Item_Node) then
+ Append (Item_Node, Priv_Decls);
+ end if;
+
+ P_Pragmas_Opt (Priv_Decls);
+
exit Declaration_Loop when No (Item_Node);
- Append (Item_Node, Private_Declarations (Def_Node));
end if;
end loop Declaration_Loop;
end loop Private_Loop;
when '@' =>
if Ada_Version < Ada_2020 then
- Error_Illegal_Character;
+ Error_Msg ("target_name is an Ada2020 feature", Scan_Ptr);
Scan_Ptr := Scan_Ptr + 1;
else
when N_Delay_Relative_Statement =>
Analyze_Delay_Relative (N);
+ when N_Delta_Aggregate =>
+ Analyze_Aggregate (N);
+
when N_Delay_Until_Statement =>
Analyze_Delay_Until (N);
Set_Etype (Ent, Standard_Void_Type);
Set_Parent (Ent, Parent (N));
- Enter_Name (Id);
- Set_Etype (Id, Index_Typ);
- Set_Ekind (Id, E_Variable);
- Set_Scope (Id, Ent);
+ -- Decorate the index variable in the current scope. The association
+ -- may have several choices, each one leading to a loop, so we create
+ -- this variable only once to prevent homonyms in this scope.
+
+ if No (Scope (Id)) then
+ Enter_Name (Id);
+ Set_Etype (Id, Index_Typ);
+ Set_Ekind (Id, E_Variable);
+ Set_Scope (Id, Ent);
+ end if;
Push_Scope (Ent);
Dummy := Resolve_Aggr_Expr (Expression (N), False);
return Failure;
end if;
+ elsif Nkind (Assoc) = N_Iterated_Component_Association then
+ null; -- handled above, in a loop context.
+
elsif not Resolve_Aggr_Expr
(Expression (Assoc), Single_Elmt => Single_Choice)
then
return Success;
end Resolve_Array_Aggregate;
+ -----------------------------
+ -- Resolve_Delta_Aggregate --
+ -----------------------------
+
+ procedure Resolve_Delta_Aggregate (N : Node_Id; Typ : Entity_Id) is
+ Base : constant Node_Id := Expression (N);
+ Deltas : constant List_Id := Component_Associations (N);
+ Assoc : Node_Id;
+ Choice : Node_Id;
+ Comp_Type : Entity_Id;
+ Index_Type : Entity_Id;
+
+ function Get_Component_Type (Nam : Node_Id) return Entity_Id;
+
+ ------------------------
+ -- Get_Component_Type --
+ ------------------------
+
+ function Get_Component_Type (Nam : Node_Id) return Entity_Id is
+ Comp : Entity_Id;
+
+ begin
+ Comp := First_Entity (Typ);
+
+ while Present (Comp) loop
+ if Chars (Comp) = Chars (Nam) then
+ if Ekind (Comp) = E_Discriminant then
+ Error_Msg_N ("delta cannot apply to discriminant", Nam);
+ end if;
+
+ return Etype (Comp);
+ end if;
+
+ Comp := Next_Entity (Comp);
+ end loop;
+
+ Error_Msg_NE ("type& has no component with this name", Nam, Typ);
+ return Any_Type;
+ end Get_Component_Type;
+
+ begin
+ if not Is_Composite_Type (Typ) then
+ Error_Msg_N ("not a composite type", N);
+ end if;
+
+ Analyze_And_Resolve (Base, Typ);
+ if Is_Array_Type (Typ) then
+ Index_Type := Etype (First_Index (Typ));
+ Assoc := First (Deltas);
+ while Present (Assoc) loop
+ if Nkind (Assoc) = N_Iterated_Component_Association then
+ Choice := First (Choice_List (Assoc));
+ while Present (Choice) loop
+ if Nkind (Choice) = N_Others_Choice then
+ Error_Msg_N
+ ("others not allowed in delta aggregate", Choice);
+
+ else
+ Analyze_And_Resolve (Choice, Index_Type);
+ end if;
+
+ Next (Choice);
+ end loop;
+
+ declare
+ Id : constant Entity_Id := Defining_Identifier (Assoc);
+ Ent : constant Entity_Id :=
+ New_Internal_Entity
+ (E_Loop, Current_Scope, Sloc (Assoc), 'L');
+
+ begin
+ Set_Etype (Ent, Standard_Void_Type);
+ Set_Parent (Ent, Assoc);
+
+ if No (Scope (Id)) then
+ Enter_Name (Id);
+ Set_Etype (Id, Index_Type);
+ Set_Ekind (Id, E_Variable);
+ Set_Scope (Id, Ent);
+ end if;
+
+ Push_Scope (Ent);
+ Analyze_And_Resolve
+ (New_Copy_Tree (Expression (Assoc)), Component_Type (Typ));
+ End_Scope;
+ end;
+
+ else
+ Choice := First (Choice_List (Assoc));
+ while Present (Choice) loop
+ if Nkind (Choice) = N_Others_Choice then
+ Error_Msg_N
+ ("others not allowed in delta aggregate", Choice);
+
+ else
+ Analyze (Choice);
+ if Is_Entity_Name (Choice)
+ and then Is_Type (Entity (Choice))
+ then
+ -- Choice covers a range of values.
+ if Base_Type (Entity (Choice)) /=
+ Base_Type (Index_Type)
+ then
+ Error_Msg_NE ("choice does mat match index type of",
+ Choice, Typ);
+ end if;
+ else
+ Resolve (Choice, Index_Type);
+ end if;
+ end if;
+
+ Next (Choice);
+ end loop;
+
+ Analyze_And_Resolve (Expression (Assoc), Component_Type (Typ));
+ end if;
+
+ Next (Assoc);
+ end loop;
+
+ else
+ Assoc := First (Deltas);
+ while Present (Assoc) loop
+ Choice := First (Choice_List (Assoc));
+ while Present (Choice) loop
+ Comp_Type := Get_Component_Type (Choice);
+ Next (Choice);
+ end loop;
+
+ Analyze_And_Resolve (Expression (Assoc), Comp_Type);
+ Next (Assoc);
+ end loop;
+ end if;
+
+ Set_Etype (N, Typ);
+ end Resolve_Delta_Aggregate;
+
---------------------------------
-- Resolve_Extension_Aggregate --
---------------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
package Sem_Aggr is
+ procedure Resolve_Delta_Aggregate (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Aggregate (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Extension_Aggregate (N : Node_Id; Typ : Entity_Id);
when N_Character_Literal =>
Resolve_Character_Literal (N, Ctx_Type);
+ when N_Delta_Aggregate =>
+ Resolve_Delta_Aggregate (N, Ctx_Type);
+
when N_Expanded_Name =>
Resolve_Entity_Name (N, Ctx_Type);
begin
pragma Assert (False
or else NT (N).Nkind = N_Aggregate
+ or else NT (N).Nkind = N_Delta_Aggregate
or else NT (N).Nkind = N_Extension_Aggregate);
return List2 (N);
end Component_Associations;
or else NT (N).Nkind = N_Component_Declaration
or else NT (N).Nkind = N_Delay_Relative_Statement
or else NT (N).Nkind = N_Delay_Until_Statement
+ or else NT (N).Nkind = N_Delta_Aggregate
or else NT (N).Nkind = N_Discriminant_Association
or else NT (N).Nkind = N_Discriminant_Specification
or else NT (N).Nkind = N_Exception_Declaration
begin
pragma Assert (False
or else NT (N).Nkind = N_Aggregate
+ or else NT (N).Nkind = N_Delta_Aggregate
or else NT (N).Nkind = N_Extension_Aggregate);
Set_List2_With_Parent (N, Val);
end Set_Component_Associations;
or else NT (N).Nkind = N_Component_Declaration
or else NT (N).Nkind = N_Delay_Relative_Statement
or else NT (N).Nkind = N_Delay_Until_Statement
+ or else NT (N).Nkind = N_Delta_Aggregate
or else NT (N).Nkind = N_Discriminant_Association
or else NT (N).Nkind = N_Discriminant_Specification
or else NT (N).Nkind = N_Exception_Declaration
-- Note that Box_Present is always False, but it is intentionally added
-- for completeness.
+ ----------------------------
+ -- 4.3.4 Delta Aggregate --
+ ----------------------------
+
+ -- N_Delta_Aggregate
+ -- Sloc points to left parenthesis
+ -- Expression (Node3)
+ -- Component_Associations (List2)
+
--------------------------------------------------
-- 4.4 Expression/Relation/Term/Factor/Primary --
--------------------------------------------------
N_Aggregate,
N_Allocator,
N_Case_Expression,
+ N_Delta_Aggregate,
N_Extension_Aggregate,
N_Raise_Expression,
N_Range,
4 => True, -- Discrete_Choices (List4)
5 => False), -- unused
+ N_Delta_Aggregate =>
+ (1 => False, -- Expressions (List1)
+ 2 => True, -- Component_Associations (List2)
+ 3 => True, -- Expression (Node3)
+ 4 => False, -- Unused
+ 5 => False), -- Etype (Node5-Sem)
+
N_Extension_Aggregate =>
(1 => True, -- Expressions (List1)
2 => True, -- Component_Associations (List2)
Write_Indent_Str (";");
end if;
+ when N_Delta_Aggregate =>
+ Write_Str_With_Col_Check_Sloc ("(");
+ Sprint_Node (Expression (Node));
+ Write_Str_With_Col_Check (" with delta ");
+ Sprint_Comma_List (Component_Associations (Node));
+ Write_Char (')');
+
when N_Extension_Aggregate =>
Write_Str_With_Col_Check_Sloc ("(");
Sprint_Node (Ancestor_Part (Node));
projects / thirdparty / gcc.git / commitdiff
