[Ada] Fix bugs in Base_Type_Only (etc.) fields

gcc/ada/

	* gen_il-gen.adb (Put_Seinfo): Generate type
	Seinfo.Type_Only_Enum based on type
	Gen_IL.Internals.Type_Only_Enum. Automatically generating a copy
	of the type will help keep them in sync.  (Note that there are
	no Ada compiler packages imported into Gen_IL.)  Add a Type_Only
	field to Field_Descriptor, so this information is available in
	the Ada compiler (as opposed to just in the Gen_IL "compiler").
	(One_Comp): Add initialization of the Type_Only field of
	Field_Descriptor.
	* gen_il-internals.ads (Image): Image function for
	Type_Only_Enum.
	* atree.ads (Node_To_Fetch_From): New function to compute which
	node to fetch from, based on the Type_Only aspect.
	* atree.adb (Get_Field_Value): Call Node_To_Fetch_From.
	* treepr.adb (Print_Entity_Field): Call Node_To_Fetch_From.
	(Print_Node_Field): Assert.
	* sinfo-utils.adb (Walk_Sinfo_Fields,
	Walk_Sinfo_Fields_Pairwise): Asserts.

1 files changed, 15 insertions, 0 deletions

diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index 4861236b669..c239507c93c 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -47,6 +47,7 @@
 with Alloc;
 with Sinfo.Nodes;    use Sinfo.Nodes;
 with Einfo.Entities; use Einfo.Entities;
+with Einfo.Utils;    use Einfo.Utils;
 with Types;          use Types;
 with Seinfo;         use Seinfo;
 with System;         use System;
@@ -616,6 +617,20 @@ package Atree is
    --  always the same; for example we change from E_Void, to E_Variable, to
    --  E_Void, to E_Constant.
 
+   function Node_To_Fetch_From
+     (N : Node_Or_Entity_Id; Field : Node_Or_Entity_Field)
+     return Node_Or_Entity_Id is
+      (case Field_Descriptors (Field).Type_Only is
+         when No_Type_Only => N,
+         when Base_Type_Only => Base_Type (N),
+         when Impl_Base_Type_Only => Implementation_Base_Type (N),
+         when Root_Type_Only => Root_Type (N));
+   --  This is analogous to the same-named function in Gen_IL.Gen. Normally,
+   --  Type_Only is No_Type_Only, and we fetch the field from the node N. But
+   --  if Type_Only = Base_Type_Only, we need to go to the Base_Type, and
+   --  similarly for the other two cases. This can return something other
+   --  than N only if N is an Entity.
+
    -----------------------------
    -- Private Part Subpackage --
    -----------------------------