Skip to content

R
riscv-gcc-1
Commit a702c9b9 by Ed Schonberg Committed by Arnaud Charlet
Options

exp_util.adb (Insert_Actions): Handle Iterated_Component_Association. 

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.

From-SVN: r244403
parent 0acd830b
Showing with 212 additions and 59 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/exp_util.adb
......@@ -5715,49 +5715,50 @@ package body Exp_Util is
-- 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
......
gcc/ada/par-ch3.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -3852,6 +3852,10 @@ package body Ch3 is
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
......
gcc/ada/par-ch4.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -76,6 +76,7 @@ package body Ch4 is
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;
......@@ -1260,6 +1261,10 @@ package body Ch4 is
-- 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 --
---------------
......@@ -1281,6 +1286,22 @@ package body Ch4 is
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
......@@ -1309,7 +1330,7 @@ package body Ch4 is
-- 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);
......@@ -1338,6 +1359,11 @@ package body Ch4 is
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
......@@ -1425,7 +1451,7 @@ package body Ch4 is
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
......@@ -1515,7 +1541,7 @@ package body Ch4 is
-- 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;
......@@ -1527,11 +1553,15 @@ package body Ch4 is
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;
......@@ -1562,6 +1592,7 @@ package body Ch4 is
-- 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
......@@ -2718,12 +2749,21 @@ package body Ch4 is
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;
......@@ -2786,7 +2826,7 @@ package body Ch4 is
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
......@@ -3172,12 +3212,40 @@ package body Ch4 is
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;
......@@ -3355,7 +3423,9 @@ package body Ch4 is
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
......@@ -3376,14 +3446,28 @@ package body Ch4 is
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)
......
gcc/ada/sem.adb
......@@ -698,6 +698,7 @@ package body Sem is
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 |
......
gcc/ada/sem_aggr.adb
......@@ -2475,7 +2475,11 @@ package body Sem_Aggr is
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;
......
gcc/ada/sinfo.adb
......@@ -790,6 +790,7 @@ package body Sinfo is
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
......@@ -879,6 +880,7 @@ package body Sinfo is
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;
......@@ -1268,6 +1270,7 @@ package body Sinfo is
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
......@@ -4086,6 +4089,7 @@ package body Sinfo is
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
......@@ -4175,6 +4179,7 @@ package body Sinfo is
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;
......@@ -4555,6 +4560,7 @@ package body Sinfo is
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
......
gcc/ada/sinfo.ads
......@@ -4098,8 +4098,24 @@ package Sinfo is
-- 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 --
......@@ -8645,6 +8661,7 @@ package Sinfo is
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,
......@@ -11463,6 +11480,13 @@ package Sinfo is
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)
......
gcc/ada/sprint.adb
......@@ -1328,6 +1328,15 @@ package body Sprint is
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));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment