From f18344b78d624afadca4c13bcca99d3a159135ec Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 10 Oct 2019 15:24:01 +0000 Subject: [PATCH] [Ada] 'others' in conditional_expressions 2019-10-10 Bob Duff 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 --- gcc/ada/ChangeLog | 11 ++++++----- gcc/ada/atree.adb | 24 ++++++++++++++++++++++++ gcc/ada/atree.ads | 21 +++++++++++++++++++++ gcc/ada/sem_aggr.adb | 48 +++++++++++++++++++++++++----------------------- gcc/ada/sinfo.adb | 38 ++++++++++++++++++++++++++++++++++++++ gcc/ada/sinfo.ads | 21 +++++++++++++++++++++ 6 files changed, 135 insertions(+), 28 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 97e2dcf..4685380 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,6 +1,7 @@ -2019-10-10 Ed Schonberg +2019-10-10 Bob Duff - * sem_aggr.adb (Resolve_Array_Aggregate): Set properly the - Predicated_Parent link of an itype created for an aggregate, so - that the predicate_function of the parent can support proofs on - the object that it initializes. \ No newline at end of file + * 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. \ No newline at end of file diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 1521941..ef1d885 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -1924,6 +1924,30 @@ package body Atree is V11); 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 -- -------- diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 7de8a9e..e6617e9 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -780,6 +780,27 @@ package Atree is V10 : Node_Kind; 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); -- Inline all above functions diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 3db998d..d6d7c59 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -893,7 +893,6 @@ package body Sem_Aggr is procedure Resolve_Aggregate (N : Node_Id; Typ : Entity_Id) is Loc : constant Source_Ptr := Sloc (N); - Pkind : constant Node_Kind := Nkind (Parent (N)); Aggr_Subtyp : Entity_Id; -- The actual aggregate subtype. This is not necessarily the same as Typ @@ -1078,16 +1077,17 @@ package body Sem_Aggr is -- permit it, or the aggregate type is unconstrained, an OTHERS -- choice is not allowed (except that it is always allowed on 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 -- mode) actual subtypes cannot be constructed, and the type of an -- object may be its unconstrained nominal type. However, if the - -- context is an assignment, we assume that OTHERS is allowed, - -- because the target of the assignment will have a constrained - -- subtype when fully compiled. Ditto if the context is an - -- initialization procedure where a component may have a predicate - -- function that carries the base type. + -- context is an assignment statement, OTHERS is allowed, because + -- the target of the assignment will have a constrained subtype + -- when fully compiled. Ditto if the context is an initialization + -- procedure where a component may have a predicate function that + -- carries the base type. -- Note that there is no node for Explicit_Actual_Parameter. -- To test for this context we therefore have to test for node @@ -1101,24 +1101,26 @@ package body Sem_Aggr is 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 (Is_Constrained (Typ) - and then - (Pkind = N_Parameter_Association or else - Pkind = N_Function_Call or else - Pkind = N_Procedure_Call_Statement or else - Pkind = N_Generic_Association or else - Pkind = N_Formal_Object_Declaration or else - Pkind = N_Simple_Return_Statement or else - Pkind = N_Object_Declaration or else - Pkind = N_Component_Declaration or else - Pkind = N_Parameter_Specification or else - Pkind = N_Qualified_Expression or else - Pkind = N_Reference or else - Pkind = N_Aggregate or else - Pkind = N_Extension_Aggregate or else - Pkind = N_Component_Association)) + and then Nkind_In (Parent (N), + N_Parameter_Association, + N_Function_Call, + N_Procedure_Call_Statement, + N_Generic_Association, + N_Formal_Object_Declaration, + N_Simple_Return_Statement, + N_Object_Declaration, + N_Component_Declaration, + N_Parameter_Specification, + N_Qualified_Expression, + N_Reference, + N_Aggregate, + N_Extension_Aggregate, + N_Component_Association, + N_Case_Expression_Alternative, + N_If_Expression)) then Aggr_Resolved := Resolve_Array_Aggregate diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index d24938c..2689ebe 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -7295,6 +7295,44 @@ package body Sinfo is T = V11; 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 -- -------------------------- diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index dc82800..5a92066 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -11574,6 +11574,27 @@ package Sinfo is V10 : Node_Kind; 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); -- Inline all above functions -- 2.7.4