[Ada] 'others' in conditional_expressions
authorBob Duff <duff@adacore.com>
Thu, 10 Oct 2019 15:24:01 +0000 (15:24 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Thu, 10 Oct 2019 15:24:01 +0000 (15:24 +0000)
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

gcc/ada/ChangeLog
gcc/ada/atree.adb
gcc/ada/atree.ads
gcc/ada/sem_aggr.adb
gcc/ada/sinfo.adb
gcc/ada/sinfo.ads

index 97e2dcf..4685380 100644 (file)
@@ -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
index 1521941..ef1d885 100644 (file)
@@ -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 --
    --------
index 7de8a9e..e6617e9 100644 (file)
@@ -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
 
index 3db998d..d6d7c59 100644 (file)
@@ -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
index d24938c..2689ebe 100644 (file)
@@ -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 --
    --------------------------
index dc82800..5a92066 100644 (file)
@@ -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