+2017-01-13 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_util.adb (Insert_Actions): Handle Iterated_Component_Association.
+ * par-ch3.adb (P_Discrete_Choice_List): An
+ Iterated_Component_Association is an array aggregate component.
+ * par-ch4.adb (P_Iterated_Component_Association): New procedure.
+ (Is_Quantified_Expression): New function that performs a lookahead
+ to distinguish quantified expressions from iterated component
+ associations.
+ (P_Aggregate_Or_Paren_Expr): Recognize iterated component
+ associations.
+ (P_Unparen_Cond_Case_Quant_Expression, P_Primary): Ditto.
+ * sem.adb (Analyze): Handle Iterated_Component_Association.
+ * sem_aggr.adb (Resolve_Array_Aggregate): Dummy handling of iterated
+ component associations.
+ * sinfo.ads, sinfo.adb: Entries for for
+ N_Iterated_Component_Association and its fields.
+ * sprint.adb (Sprint_Node_Actual): Handle
+ N_Iterated_Component_Association.
+
2017-01-13 Justin Squirek <squirek@adacore.com>
* sem_ch12.adb (Analyze_Package_Instantiation): Move disabiling
-- at the end of the loop actions, to respect the order in which
-- they are to be elaborated.
- when
- N_Component_Association =>
- if Nkind (Parent (P)) = N_Aggregate
- and then Present (Loop_Actions (P))
- then
- if Is_Empty_List (Loop_Actions (P)) then
- Set_Loop_Actions (P, Ins_Actions);
- Analyze_List (Ins_Actions);
-
- else
- declare
- Decl : Node_Id;
-
- begin
- -- Check whether these actions were generated by a
- -- declaration that is part of the loop_ actions
- -- for the component_association.
-
- Decl := Assoc_Node;
- while Present (Decl) loop
- exit when Parent (Decl) = P
- and then Is_List_Member (Decl)
- and then
- List_Containing (Decl) = Loop_Actions (P);
- Decl := Parent (Decl);
- end loop;
-
- if Present (Decl) then
- Insert_List_Before_And_Analyze
- (Decl, Ins_Actions);
- else
- Insert_List_After_And_Analyze
- (Last (Loop_Actions (P)), Ins_Actions);
- end if;
- end;
- end if;
-
- return;
+ when N_Component_Association
+ | N_Iterated_Component_Association
+ =>
+ if Nkind (Parent (P)) = N_Aggregate
+ and then Present (Loop_Actions (P))
+ then
+ if Is_Empty_List (Loop_Actions (P)) then
+ Set_Loop_Actions (P, Ins_Actions);
+ Analyze_List (Ins_Actions);
else
- null;
+ declare
+ Decl : Node_Id;
+
+ begin
+ -- Check whether these actions were generated by a
+ -- declaration that is part of the loop_ actions for
+ -- the component_association.
+
+ Decl := Assoc_Node;
+ while Present (Decl) loop
+ exit when Parent (Decl) = P
+ and then Is_List_Member (Decl)
+ and then
+ List_Containing (Decl) = Loop_Actions (P);
+ Decl := Parent (Decl);
+ end loop;
+
+ if Present (Decl) then
+ Insert_List_Before_And_Analyze
+ (Decl, Ins_Actions);
+ else
+ Insert_List_After_And_Analyze
+ (Last (Loop_Actions (P)), Ins_Actions);
+ end if;
+ end;
end if;
+ return;
+
+ else
+ null;
+ end if;
+
-- Another special case, an attribute denoting a procedure call
when
-- --
-- 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- --
end if;
if Token = Tok_Comma then
+ if Nkind (Expr_Node) = N_Iterated_Component_Association then
+ return Choices;
+ end if;
+
Scan; -- past comma
if Token = Tok_Vertical_Bar then
-- --
-- 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- --
function P_Aggregate_Or_Paren_Expr return Node_Id;
function P_Allocator return Node_Id;
function P_Case_Expression_Alternative return Node_Id;
+ function P_Iterated_Component_Association return Node_Id;
function P_Record_Or_Array_Component_Association return Node_Id;
function P_Factor return Node_Id;
function P_Primary return Node_Id;
-- Called if <> is encountered as positional aggregate element. Issues
-- error message and sets Expr_Node to Error.
+ function Is_Quantified_Expression return Boolean;
+ -- The presence of iterated component associations requires a one
+ -- token lookahead to distinguish it from quantified expressions.
+
---------------
-- Box_Error --
---------------
Expr_Node := Error;
end Box_Error;
+ ------------------------------
+ -- Is_Quantified_Expression --
+ ------------------------------
+
+ function Is_Quantified_Expression return Boolean is
+ Maybe : Boolean;
+ Scan_State : Saved_Scan_State;
+
+ begin
+ Save_Scan_State (Scan_State);
+ Scan; -- past FOR
+ Maybe := Token = Tok_All or else Token = Tok_Some;
+ Restore_Scan_State (Scan_State); -- to FOR
+ return Maybe;
+ end Is_Quantified_Expression;
+
-- Start of processing for P_Aggregate_Or_Paren_Expr
begin
-- Quantified expression
- elsif Token = Tok_For then
+ elsif Token = Tok_For and then Is_Quantified_Expression then
Expr_Node := P_Quantified_Expression;
T_Right_Paren;
Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
else
Restore_Scan_State (Scan_State); -- to NULL that must be expr
end if;
+
+ elsif Token = Tok_For then
+ Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
+ Expr_Node := P_Iterated_Component_Association;
+ goto Aggregate;
end if;
-- Scan expression, handling box appearing as positional argument
end if;
-- Prepare to scan list of component associations
-
+ <<Aggregate>>
Expr_List := No_List; -- don't set yet, maybe all named entries
Assoc_List := No_List; -- don't set yet, maybe all positional entries
-- wrong, so let's get out now, before we start eating up stuff
-- that doesn't belong to us.
- if Token in Token_Class_Eterm then
+ if Token in Token_Class_Eterm and then Token /= Tok_For then
Error_Msg_AP
("expecting expression or component association");
exit;
Box_Error;
-- Otherwise initiate for reentry to top of loop by scanning an
- -- initial expression, unless the first token is OTHERS.
+ -- initial expression, unless the first token is OTHERS or FOR,
+ -- which indicates an iterated component association.
elsif Token = Tok_Others then
Expr_Node := Empty;
+ elsif Token = Tok_For then
+ Expr_Node := P_Iterated_Component_Association;
+
else
Save_Scan_State (Scan_State); -- at start of expression
Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
-- ARRAY_COMPONENT_ASSOCIATION ::=
-- DISCRETE_CHOICE_LIST => EXPRESSION
-- | DISCRETE_CHOICE_LIST => <>
+ -- | ITERATED_COMPONENT_ASSOCIATION
-- Note: this routine only handles the named cases, including others.
-- Cases where the component choice list is not present have already
return Error;
elsif Ada_Version >= Ada_2012 then
- Node1 := P_Quantified_Expression;
+ Save_Scan_State (Scan_State);
+ Scan; -- past FOR
- if not (Lparen and then Token = Tok_Right_Paren) then
- Error_Msg
- ("quantified expression must be parenthesized",
- Sloc (Node1));
+ if Token = Tok_All or else Token = Tok_Some then
+ Restore_Scan_State (Scan_State); -- To FOR
+ Node1 := P_Quantified_Expression;
+
+ if not (Lparen and then Token = Tok_Right_Paren) then
+ Error_Msg
+ ("quantified expression must be parenthesized",
+ Sloc (Node1));
+ end if;
+ else
+ Restore_Scan_State (Scan_State); -- To FOR
+ Node1 := P_Iterated_Component_Association;
end if;
return Node1;
raise Error_Resync;
end if;
- Scan; -- past SOME
+ Scan; -- past ALL or SOME
I_Spec := P_Loop_Parameter_Specification;
if Nkind (I_Spec) = N_Loop_Parameter_Specification then
return Case_Alt_Node;
end P_Case_Expression_Alternative;
+ --------------------------------------
+ -- P_Iterated_Component_Association --
+ --------------------------------------
+
+ -- ITERATED_COMPONENT_ASSOCIATION ::=
+ -- for DEFINING_IDENTIFIER in DISCRETE_CHOICE_LIST => EXPRESSION
+
+ function P_Iterated_Component_Association return Node_Id is
+ Assoc_Node : Node_Id;
+
+ begin
+ Scan; -- past FOR
+ Assoc_Node :=
+ New_Node (N_Iterated_Component_Association, Prev_Token_Ptr);
+ Set_Defining_Identifier (Assoc_Node, P_Defining_Identifier);
+ T_In;
+ Set_Discrete_Choices (Assoc_Node, P_Discrete_Choice_List);
+ TF_Arrow;
+ Set_Expression (Assoc_Node, P_Expression);
+ return Assoc_Node;
+ end P_Iterated_Component_Association;
+
---------------------
-- P_If_Expression --
---------------------
- function P_If_Expression return Node_Id is
+ -- IF_EXPRESSION ::=
+ -- if CONDITION then DEPENDENT_EXPRESSION
+ -- {elsif CONDITION then DEPENDENT_EXPRESSION}
+ -- [else DEPENDENT_EXPRESSION]
+
+ -- DEPENDENT_EXPRESSION ::= EXPRESSION
+ function P_If_Expression return Node_Id is
function P_If_Expression_Internal
(Loc : Source_Ptr;
Cond : Node_Id) return Node_Id;
function P_Unparen_Cond_Case_Quant_Expression return Node_Id is
Lparen : constant Boolean := Prev_Token = Tok_Left_Paren;
- Result : Node_Id;
+
+ Result : Node_Id;
+ Scan_State : Saved_Scan_State;
begin
-- Case expression
Error_Msg_N ("if expression must be parenthesized!", Result);
end if;
- -- Quantified expression
+ -- Quantified expression or iterated component association
elsif Token = Tok_For then
- Result := P_Quantified_Expression;
- if not (Lparen and then Token = Tok_Right_Paren) then
- Error_Msg_N
- ("quantified expression must be parenthesized!", Result);
+ Save_Scan_State (Scan_State);
+ Scan; -- past FOR
+
+ if Token = Tok_All or else Token = Tok_Some then
+ Restore_Scan_State (Scan_State);
+ Result := P_Quantified_Expression;
+
+ if not (Lparen and then Token = Tok_Right_Paren) then
+ Error_Msg_N
+ ("quantified expression must be parenthesized!", Result);
+ end if;
+
+ else
+ -- If no quantifier keyword, this is an iterated component in
+ -- an aggregate.
+
+ Restore_Scan_State (Scan_State);
+ Result := P_Iterated_Component_Association;
end if;
-- No other possibility should exist (caller was supposed to check)
N_Function_Specification |
N_Generic_Association |
N_Index_Or_Discriminant_Constraint |
+ N_Iterated_Component_Association |
N_Iteration_Scheme |
N_Mod_Clause |
N_Modular_Type_Definition |
Check_Can_Never_Be_Null (Etype (N), Expr);
end if;
- if not Resolve_Aggr_Expr (Expr, Single_Elmt => True) then
+ if Nkind (Expr) = N_Iterated_Component_Association then
+ Error_Msg_N ("iterated association not implemented yet", Expr);
+ return Failure;
+
+ elsif not Resolve_Aggr_Expr (Expr, Single_Elmt => True) then
return Failure;
end if;
or else NT (N).Nkind = N_Full_Type_Declaration
or else NT (N).Nkind = N_Implicit_Label_Declaration
or else NT (N).Nkind = N_Incomplete_Type_Declaration
+ or else NT (N).Nkind = N_Iterated_Component_Association
or else NT (N).Nkind = N_Iterator_Specification
or else NT (N).Nkind = N_Loop_Parameter_Specification
or else NT (N).Nkind = N_Number_Declaration
pragma Assert (False
or else NT (N).Nkind = N_Case_Expression_Alternative
or else NT (N).Nkind = N_Case_Statement_Alternative
+ or else NT (N).Nkind = N_Iterated_Component_Association
or else NT (N).Nkind = N_Variant);
return List4 (N);
end Discrete_Choices;
or else NT (N).Nkind = N_Expression_Function
or else NT (N).Nkind = N_Expression_With_Actions
or else NT (N).Nkind = N_Free_Statement
+ or else NT (N).Nkind = N_Iterated_Component_Association
or else NT (N).Nkind = N_Mod_Clause
or else NT (N).Nkind = N_Modular_Type_Definition
or else NT (N).Nkind = N_Number_Declaration
or else NT (N).Nkind = N_Full_Type_Declaration
or else NT (N).Nkind = N_Implicit_Label_Declaration
or else NT (N).Nkind = N_Incomplete_Type_Declaration
+ or else NT (N).Nkind = N_Iterated_Component_Association
or else NT (N).Nkind = N_Iterator_Specification
or else NT (N).Nkind = N_Loop_Parameter_Specification
or else NT (N).Nkind = N_Number_Declaration
pragma Assert (False
or else NT (N).Nkind = N_Case_Expression_Alternative
or else NT (N).Nkind = N_Case_Statement_Alternative
+ or else NT (N).Nkind = N_Iterated_Component_Association
or else NT (N).Nkind = N_Variant);
Set_List4_With_Parent (N, Val);
end Set_Discrete_Choices;
or else NT (N).Nkind = N_Expression_Function
or else NT (N).Nkind = N_Expression_With_Actions
or else NT (N).Nkind = N_Free_Statement
+ or else NT (N).Nkind = N_Iterated_Component_Association
or else NT (N).Nkind = N_Mod_Clause
or else NT (N).Nkind = N_Modular_Type_Definition
or else NT (N).Nkind = N_Number_Declaration
-- ARRAY_COMPONENT_ASSOCIATION ::=
-- DISCRETE_CHOICE_LIST => EXPRESSION
+ -- | ITERATED_COMPONENT_ASSOCIATION
-- See Record_Component_Association (4.3.1) for node structure
+ -- The iterated_component_association is introduced into the
+ -- Corrigendum of Ada_2012 by AI12-061.
+
+ ------------------------------------------
+ -- 4.3.3 Iterated component Association --
+ ------------------------------------------
+
+ -- ITERATED_COMPONENT_ASSOCIATION ::=
+ -- for DEFINING_IDENTIFIER in DISCRETE_CHOICE_LIST => EXPRESSION
+
+ -- N_Iterated_Component_Association
+ -- Sloc points to FOR
+ -- Defining_Identifier (Node1)
+ -- Expression (Node3)
+ -- Discrete_Choices (List4)
--------------------------------------------------
-- 4.4 Expression/Relation/Term/Factor/Primary --
N_Generic_Association,
N_Handled_Sequence_Of_Statements,
N_Index_Or_Discriminant_Constraint,
+ N_Iterated_Component_Association,
N_Itype_Reference,
N_Label,
N_Modular_Type_Definition,
4 => False, -- unused
5 => False), -- unused
+ N_Iterated_Component_Association =>
+ (1 => True, -- Defining_Identifier (Node1)
+ 2 => False, -- unused
+ 3 => True, -- Expression (Node3)
+ 4 => True, -- Discrete_Choices (List4)
+ 5 => False), -- unused
+
N_Extension_Aggregate =>
(1 => True, -- Expressions (List1)
2 => True, -- Component_Associations (List2)
Sprint_Node (Expression (Node));
end if;
+ when N_Iterated_Component_Association =>
+ Set_Debug_Sloc;
+ Write_Str (" for ");
+ Write_Id (Defining_Identifier (Node));
+ Write_Str (" in ");
+ Sprint_Bar_List (Choices (Node));
+ Write_Str (" => ");
+ Sprint_Node (Expression (Node));
+
when N_Component_Clause =>
Write_Indent;
Sprint_Node (Component_Name (Node));
projects / gcc.git / commitdiff