aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBob Duff <duff@adacore.com>2019-10-10 15:24:01 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-10-10 15:24:01 +0000
commitf18344b78d624afadca4c13bcca99d3a159135ec (patch)
tree27068cb55425ff33c680533d0eea4acfae4b3f13
parenta096f12eae91f891ef17687a9c48fee3de0b2fdd (diff)
downloadgcc-f18344b78d624afadca4c13bcca99d3a159135ec.zip
gcc-f18344b78d624afadca4c13bcca99d3a159135ec.tar.gz
gcc-f18344b78d624afadca4c13bcca99d3a159135ec.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog11
-rw-r--r--gcc/ada/atree.adb24
-rw-r--r--gcc/ada/atree.ads21
-rw-r--r--gcc/ada/sem_aggr.adb48
-rw-r--r--gcc/ada/sinfo.adb38
-rw-r--r--gcc/ada/sinfo.ads21
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 <schonberg@adacore.com>
+2019-10-10 Bob Duff <duff@adacore.com>
- * 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