Skip to content

R
riscv-gcc-1
Commit f18344b7 by Bob Duff Committed by Pierre-Marie de Rodat
Options

[Ada] 'others' in conditional_expressions 

2019-10-10  Bob Duff  <duff@adacore.com>

gcc/ada/

	* sem_aggr.adb (Resolve_Aggregate): Add missing cases in the
	Others_Allowed => True case -- N_Case_Expression_Alternative and
	N_If_Expression.  Use Nkind_In.
	* atree.adb, atree.ads, sinfo.adb, sinfo.ads (Nkind_In): New
	16-parameter version.

From-SVN: r276824
parent a096f12e
Showing with 136 additions and 29 deletions
gcc/ada/ChangeLog
2019-10-10 Ed Schonberg <schonberg@adacore.com> 2019-10-10 Bob Duff <duff@adacore.com>
* sem_aggr.adb (Resolve_Array_Aggregate): Set properly the * sem_aggr.adb (Resolve_Aggregate): Add missing cases in the
Predicated_Parent link of an itype created for an aggregate, so Others_Allowed => True case -- N_Case_Expression_Alternative and
that the predicate_function of the parent can support proofs on N_If_Expression. Use Nkind_In.
the object that it initializes. * atree.adb, atree.ads, sinfo.adb, sinfo.ads (Nkind_In): New
\ No newline at end of file 16-parameter version.
\ No newline at end of file
gcc/ada/atree.adb
...@@ -1924,6 +1924,30 @@ package body Atree is ...@@ -1924,6 +1924,30 @@ package body Atree is
V11); V11);
end Nkind_In; end Nkind_In;
function Nkind_In
(N : Node_Id;
V1 : Node_Kind;
V2 : Node_Kind;
V3 : Node_Kind;
V4 : Node_Kind;
V5 : Node_Kind;
V6 : Node_Kind;
V7 : Node_Kind;
V8 : Node_Kind;
V9 : Node_Kind;
V10 : Node_Kind;
V11 : Node_Kind;
V12 : Node_Kind;
V13 : Node_Kind;
V14 : Node_Kind;
V15 : Node_Kind;
V16 : Node_Kind) return Boolean
is
begin
return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6, V7, V8, V9, V10,
V11, V12, V13, V14, V15, V16);
end Nkind_In;
-------- --------
-- No -- -- No --
-------- --------
......
gcc/ada/atree.ads
...@@ -780,6 +780,27 @@ package Atree is ...@@ -780,6 +780,27 @@ package Atree is
V10 : Node_Kind; V10 : Node_Kind;
V11 : Node_Kind) return Boolean; V11 : Node_Kind) return Boolean;
-- 12..15-parameter versions are not yet needed
function Nkind_In
(N : Node_Id;
V1 : Node_Kind;
V2 : Node_Kind;
V3 : Node_Kind;
V4 : Node_Kind;
V5 : Node_Kind;
V6 : Node_Kind;
V7 : Node_Kind;
V8 : Node_Kind;
V9 : Node_Kind;
V10 : Node_Kind;
V11 : Node_Kind;
V12 : Node_Kind;
V13 : Node_Kind;
V14 : Node_Kind;
V15 : Node_Kind;
V16 : Node_Kind) return Boolean;
pragma Inline (Nkind_In); pragma Inline (Nkind_In);
-- Inline all above functions -- Inline all above functions
......
gcc/ada/sem_aggr.adb
...@@ -893,7 +893,6 @@ package body Sem_Aggr is ...@@ -893,7 +893,6 @@ package body Sem_Aggr is
procedure Resolve_Aggregate (N : Node_Id; Typ : Entity_Id) is procedure Resolve_Aggregate (N : Node_Id; Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Pkind : constant Node_Kind := Nkind (Parent (N));
Aggr_Subtyp : Entity_Id; Aggr_Subtyp : Entity_Id;
-- The actual aggregate subtype. This is not necessarily the same as Typ -- The actual aggregate subtype. This is not necessarily the same as Typ
...@@ -1078,16 +1077,17 @@ package body Sem_Aggr is ...@@ -1078,16 +1077,17 @@ package body Sem_Aggr is
-- permit it, or the aggregate type is unconstrained, an OTHERS -- permit it, or the aggregate type is unconstrained, an OTHERS
-- choice is not allowed (except that it is always allowed on the -- choice is not allowed (except that it is always allowed on the
-- right-hand side of an assignment statement; in this case the -- right-hand side of an assignment statement; in this case the
-- constrainedness of the type doesn't matter). -- constrainedness of the type doesn't matter, because an array
-- object is always constrained).
-- If expansion is disabled (generic context, or semantics-only -- If expansion is disabled (generic context, or semantics-only
-- mode) actual subtypes cannot be constructed, and the type of an -- mode) actual subtypes cannot be constructed, and the type of an
-- object may be its unconstrained nominal type. However, if the -- object may be its unconstrained nominal type. However, if the
-- context is an assignment, we assume that OTHERS is allowed, -- context is an assignment statement, OTHERS is allowed, because
-- because the target of the assignment will have a constrained -- the target of the assignment will have a constrained subtype
-- subtype when fully compiled. Ditto if the context is an -- when fully compiled. Ditto if the context is an initialization
-- initialization procedure where a component may have a predicate -- procedure where a component may have a predicate function that
-- function that carries the base type. -- carries the base type.
-- Note that there is no node for Explicit_Actual_Parameter. -- Note that there is no node for Explicit_Actual_Parameter.
-- To test for this context we therefore have to test for node -- To test for this context we therefore have to test for node
...@@ -1101,24 +1101,26 @@ package body Sem_Aggr is ...@@ -1101,24 +1101,26 @@ package body Sem_Aggr is
Set_Etype (N, Aggr_Typ); -- May be overridden later on Set_Etype (N, Aggr_Typ); -- May be overridden later on
if Pkind = N_Assignment_Statement if Nkind (Parent (N)) = N_Assignment_Statement
or else Inside_Init_Proc or else Inside_Init_Proc
or else (Is_Constrained (Typ) or else (Is_Constrained (Typ)
and then and then Nkind_In (Parent (N),
(Pkind = N_Parameter_Association or else N_Parameter_Association,
Pkind = N_Function_Call or else N_Function_Call,
Pkind = N_Procedure_Call_Statement or else N_Procedure_Call_Statement,
Pkind = N_Generic_Association or else N_Generic_Association,
Pkind = N_Formal_Object_Declaration or else N_Formal_Object_Declaration,
Pkind = N_Simple_Return_Statement or else N_Simple_Return_Statement,
Pkind = N_Object_Declaration or else N_Object_Declaration,
Pkind = N_Component_Declaration or else N_Component_Declaration,
Pkind = N_Parameter_Specification or else N_Parameter_Specification,
Pkind = N_Qualified_Expression or else N_Qualified_Expression,
Pkind = N_Reference or else N_Reference,
Pkind = N_Aggregate or else N_Aggregate,
Pkind = N_Extension_Aggregate or else N_Extension_Aggregate,
Pkind = N_Component_Association)) N_Component_Association,
N_Case_Expression_Alternative,
N_If_Expression))
then then
Aggr_Resolved := Aggr_Resolved :=
Resolve_Array_Aggregate Resolve_Array_Aggregate
......
gcc/ada/sinfo.adb
...@@ -7295,6 +7295,44 @@ package body Sinfo is ...@@ -7295,6 +7295,44 @@ package body Sinfo is
T = V11; T = V11;
end Nkind_In; end Nkind_In;
function Nkind_In
(T : Node_Kind;
V1 : Node_Kind;
V2 : Node_Kind;
V3 : Node_Kind;
V4 : Node_Kind;
V5 : Node_Kind;
V6 : Node_Kind;
V7 : Node_Kind;
V8 : Node_Kind;
V9 : Node_Kind;
V10 : Node_Kind;
V11 : Node_Kind;
V12 : Node_Kind;
V13 : Node_Kind;
V14 : Node_Kind;
V15 : Node_Kind;
V16 : Node_Kind) return Boolean
is
begin
return T = V1 or else
T = V2 or else
T = V3 or else
T = V4 or else
T = V5 or else
T = V6 or else
T = V7 or else
T = V8 or else
T = V9 or else
T = V10 or else
T = V11 or else
T = V12 or else
T = V13 or else
T = V14 or else
T = V15 or else
T = V16;
end Nkind_In;
-------------------------- --------------------------
-- Pragma_Name_Unmapped -- -- Pragma_Name_Unmapped --
-------------------------- --------------------------
......
gcc/ada/sinfo.ads
...@@ -11574,6 +11574,27 @@ package Sinfo is ...@@ -11574,6 +11574,27 @@ package Sinfo is
V10 : Node_Kind; V10 : Node_Kind;
V11 : Node_Kind) return Boolean; V11 : Node_Kind) return Boolean;
-- 12..15-parameter versions are not yet needed
function Nkind_In
(T : Node_Kind;
V1 : Node_Kind;
V2 : Node_Kind;
V3 : Node_Kind;
V4 : Node_Kind;
V5 : Node_Kind;
V6 : Node_Kind;
V7 : Node_Kind;
V8 : Node_Kind;
V9 : Node_Kind;
V10 : Node_Kind;
V11 : Node_Kind;
V12 : Node_Kind;
V13 : Node_Kind;
V14 : Node_Kind;
V15 : Node_Kind;
V16 : Node_Kind) return Boolean;
pragma Inline (Nkind_In); pragma Inline (Nkind_In);
-- Inline all above functions -- Inline all above functions
......
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