[gcc r14-2898] ada: check Atree.Get/Set_Field_Value

[gcc r14-2898] ada: check Atree.Get/Set_Field_Value

[Marc Poulhi?s]

https://gcc.gnu.org/g:62d8dae02728b8a991ee04133732016e2906233e

commit r14-2898-g62d8dae02728b8a991ee04133732016e2906233e
Author: Bob Duff <duff@adacore.com>
Date:   Wed May 10 15:21:15 2023 -0400

    ada: check Atree.Get/Set_Field_Value
    
    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.

Diff:
---
 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