[COMMITTED] ada: check Atree.Get/Set_Field_Value

[COMMITTED] ada: check Atree.Get/Set_Field_Value

[Marc Poulhiès]

From: Bob Duff <duff@adacore.com>

Get_Field_Value and Set_Field_Value now check that the Nkind or Ekind is
correct. However, the checks are partially disabled, because they
sometimes fail.

gcc/ada/

	* atree.adb (Field_Present): New function to detect whether or not
	a given field is present in a given node, based on either the node
	kind or the entity kind as appropriate.
	(Get_Field_Value): Check that the field begin fetched exists.
	However, disable the check in the case of Scope_Depth_Value,
	because we have failures in that case. Those failures need to be
	fixed, and then the check can be enabled for all fields.
	(Set_Field_Value): Check that the field begin set exists.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/atree.adb | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index f1e4e2ca8bb..5597d166cdb 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -265,6 +265,10 @@ package body Atree is
       --  True if a node/entity of the given Kind has the given Field.
       --  Always True if assertions are disabled.
 
+      function Field_Present
+        (N : Node_Id; Field : Node_Or_Entity_Field) return Boolean;
+      --  Same for a node, which could be an entity
+
    end Field_Checking;
 
    package body Field_Checking is
@@ -366,6 +370,17 @@ package body Atree is
          return Entity_Fields_Present (Kind) (Field);
       end Field_Present;
 
+      function Field_Present
+        (N : Node_Id; Field : Node_Or_Entity_Field) return Boolean is
+      begin
+         case Field is
+            when Node_Field =>
+               return Field_Present (Nkind (N), Field);
+            when Entity_Field =>
+               return Field_Present (Ekind (N), Field);
+         end case;
+      end Field_Present;
+
    end Field_Checking;
 
    ------------------------
@@ -885,6 +900,10 @@ package body Atree is
    function Get_Field_Value
      (N : Node_Id; Field : Node_Or_Entity_Field) return Field_Size_32_Bit
    is
+      pragma Assert
+        (if Field /= F_Scope_Depth_Value then -- ???Temporarily disable check
+           Field_Checking.Field_Present (N, Field));
+      --  Assert partially disabled because it fails in rare cases
       Desc : Field_Descriptor renames Field_Descriptors (Field);
       NN : constant Node_Or_Entity_Id := Node_To_Fetch_From (N, Field);
 
@@ -905,6 +924,7 @@ package body Atree is
    procedure Set_Field_Value
      (N : Node_Id; Field : Node_Or_Entity_Field; Val : Field_Size_32_Bit)
    is
+      pragma Assert (Field_Checking.Field_Present (N, Field));
       Desc : Field_Descriptor renames Field_Descriptors (Field);
 
    begin
-- 
2.40.0