From: Richard Kenner <kenner@adacore.com>
Date: Wed, 11 Aug 2021 17:12:55 +0000 (-0400)
Subject: [Ada] Add more node unions
X-Git-Tag: basepoints/gcc-13~4297
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=698425f5cc85ec83fa17ba08d6da0754ced198f7;p=thirdparty%2Fgcc.git

[Ada] Add more node unions

gcc/ada/

	* gen_il-gen-gen_nodes.adb (N_Alternative, N_Is_Case_Choice):
	Add.
	(N_Is_Exception_Choice, N_Is_Range): Likewise.
	* gen_il-types.ads: Add above names.
	* gen_il-gen.adb (Put_Union_Membership): Write both declarations
	and definitions of union functions.
---

diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index 2d226bfb4439..20d25ea83ac2 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -1686,4 +1686,31 @@ begin -- Gen_IL.Gen.Gen_Nodes
              N_Subprogram_Specification));
    --  Nodes that can be returned by Declaration_Node
 
+   Union (N_Is_Range,
+          Children =>
+            (N_Character_Literal,
+             N_Entity_Name,
+             N_Has_Bounds,
+             N_Integer_Literal,
+             N_Subtype_Indication));
+   --  Nodes that can be used to specify a range
+
+   Union (N_Is_Case_Choice,
+          Children =>
+            (N_Is_Range,
+             N_Others_Choice));
+   --  Nodes that can be in the choices of a case statement
+
+   Union (N_Is_Exception_Choice,
+          Children =>
+            (N_Entity_Name,
+             N_Others_Choice));
+   --  Nodes that can be in the choices of an exception handler
+
+   Union (N_Alternative,
+          Children =>
+            (N_Case_Statement_Alternative,
+             N_Variant));
+   --  Nodes that can be alternatives in case contructs
+
 end Gen_IL.Gen.Gen_Nodes;
diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb
index dd1e3a158448..e3b034a8d698 100644
--- a/gcc/ada/gen_il-gen.adb
+++ b/gcc/ada/gen_il-gen.adb
@@ -652,7 +652,7 @@ package body Gen_IL.Gen is
       --  Used by Put_C_Getters to print out one high-level getter.
 
       procedure Put_Union_Membership
-        (S : in out Sink; Root : Root_Type);
+        (S : in out Sink; Root : Root_Type; Only_Prototypes : Boolean);
       --  Used by Put_Sinfo_Dot_H and Put_Einfo_Dot_H to print out functions to
       --  test membership in a union type.
 
@@ -3175,6 +3175,8 @@ package body Gen_IL.Gen is
          end Put_Kind_Subtype;
 
       begin
+         Put_Union_Membership (S, Root, Only_Prototypes => True);
+
          Iterate_Types (Root, Pre => Put_Enum_Lit'Access);
 
          Put (S, "#define Number_" & Node_Or_Entity (Root) & "_Kinds " &
@@ -3182,7 +3184,7 @@ package body Gen_IL.Gen is
 
          Iterate_Types (Root, Pre => Put_Kind_Subtype'Access);
 
-         Put_Union_Membership (S, Root);
+         Put_Union_Membership (S, Root, Only_Prototypes => False);
       end Put_C_Type_And_Subtypes;
 
       ------------------
@@ -3269,7 +3271,7 @@ package body Gen_IL.Gen is
       --------------------------
 
       procedure Put_Union_Membership
-        (S : in out Sink; Root : Root_Type) is
+        (S : in out Sink; Root : Root_Type; Only_Prototypes : Boolean) is
 
          procedure Put_Ors (T : Abstract_Type);
          --  Print the "or" (i.e. "||") of tests whether kind is in each child
@@ -3303,22 +3305,27 @@ package body Gen_IL.Gen is
          end Put_Ors;
 
       begin
-         Put (S, LF & "// Membership tests for union types" & LF & LF);
+         if not Only_Prototypes then
+            Put (S, LF & "// Membership tests for union types" & LF & LF);
+         end if;
 
          for T in First_Abstract (Root) .. Last_Abstract (Root) loop
             if Type_Table (T) /= null and then Type_Table (T).Is_Union then
                Put (S, "INLINE Boolean" & LF);
                Put (S, "Is_In_" & Image (T) & " (" &
-                    Node_Or_Entity (Root) & "_Kind kind)" & LF);
+                    Node_Or_Entity (Root) & "_Kind kind)" &
+                    (if Only_Prototypes then ";" else "") & LF);
 
-               Put (S, "{" & LF);
-               Increase_Indent (S, 3);
-               Put (S, "return" & LF);
-               Increase_Indent (S, 3);
-               Put_Ors (T);
-               Decrease_Indent (S, 3);
-               Decrease_Indent (S, 3);
-               Put (S, ";" & LF & "}" & LF);
+               if not Only_Prototypes then
+                  Put (S, "{" & LF);
+                  Increase_Indent (S, 3);
+                  Put (S, "return" & LF);
+                  Increase_Indent (S, 3);
+                  Put_Ors (T);
+                  Decrease_Indent (S, 3);
+                  Decrease_Indent (S, 3);
+                  Put (S, ";" & LF & "}" & LF);
+               end if;
 
                Put (S, "" & LF);
             end if;
diff --git a/gcc/ada/gen_il-types.ads b/gcc/ada/gen_il-types.ads
index f7de1501874d..622bc1ffc73c 100644
--- a/gcc/ada/gen_il-types.ads
+++ b/gcc/ada/gen_il-types.ads
@@ -77,6 +77,7 @@ package Gen_IL.Types is
 
       Node_Kind, -- root of node type hierarchy
       N_Access_To_Subprogram_Definition,
+      N_Alternative,
       N_Array_Type_Definition,
       N_Binary_Op,
       N_Body_Stub,
@@ -94,8 +95,11 @@ package Gen_IL.Types is
       N_Has_Condition,
       N_Has_Entity,
       N_Has_Etype,
+      N_Is_Case_Choice,
       N_Is_Decl,
+      N_Is_Exception_Choice,
       N_Is_Index,
+      N_Is_Range,
       N_Multiplying_Operator,
       N_Later_Decl_Item,
       N_Membership_Test,