From: Bob Duff <d...@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
