diff options
Diffstat (limited to 'gcc/ada/atree.adb')
| -rw-r--r-- | gcc/ada/atree.adb | 82 |
1 files changed, 35 insertions, 47 deletions
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 327bc2d..a13438a 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -1005,61 +1005,49 @@ package body Atree is Old_Kind : constant Entity_Kind := Ekind (Old_N); - function Same_Node_To_Fetch_From - (N : Node_Or_Entity_Id; Field : Node_Or_Entity_Field) - return Boolean; - -- True if the field should be fetched from N. For most fields, this is - -- true. However, if the field is a "root type only" field, then this is - -- true only if N is the root type. If this is false, then we should not - -- do Reinit_Field_To_Zero, and we should not fail below, because the - -- field is not vanishing from the root type. Similar comments apply to - -- "base type only" and "implementation base type only" fields. - -- - -- We need to ignore exceptions here, because in some cases, - -- Node_To_Fetch_From is being called before the relevant (root, base) - -- type has been set, so we fail some assertions. - - function Same_Node_To_Fetch_From - (N : Node_Or_Entity_Id; Field : Node_Or_Entity_Field) - return Boolean is - begin - return N = Node_To_Fetch_From (N, Field); - exception - when others => return False; -- ignore the exception - end Same_Node_To_Fetch_From; - -- Start of processing for Check_Vanishing_Fields begin for J in Entity_Field_Table (Old_Kind)'Range loop declare F : constant Entity_Field := Entity_Field_Table (Old_Kind) (J); - begin - if not Same_Node_To_Fetch_From (Old_N, F) then - null; -- no check in this case - elsif not Field_Checking.Field_Present (New_Kind, F) then - if not Field_Is_Initial_Zero (Old_N, F) then - Write_Str ("# "); - Write_Str (Osint.Get_First_Main_File_Name); - Write_Str (": "); - Write_Str (Old_Kind'Img); - Write_Str (" --> "); - Write_Str (New_Kind'Img); - Write_Str (" Nonzero field "); - Write_Str (F'Img); - Write_Str (" is vanishing "); - - if New_Kind = E_Void or else Old_Kind = E_Void then - Write_Line ("(E_Void case)"); - else - Write_Line ("(non-E_Void case)"); - end if; + Same_Node_To_Fetch_From : constant Boolean := + Old_N = Node_To_Fetch_From_If_Set (Old_N, F); + -- True if the field F should be fetched from Old_N. For most + -- fields, this is True. However, if F is a "root type only" + -- field, then it should be fetched from the root type, so this is + -- true only if Old_N is the root type. If this is False, then we + -- should not have done Reinit_Field_To_Zero, and we should not + -- fail below, because the field is not vanishing from this node. + -- We use the ..._If_Set function to avoid failing when the root + -- type has not yet been set. Similar comments apply to "base type + -- only" and "implementation base type only" fields. - Write_Str (" ...mutating node "); - Write_Int (Nat (Old_N)); - Write_Line (""); - raise Program_Error; + begin + if Same_Node_To_Fetch_From + and then not Field_Checking.Field_Present (New_Kind, F) + and then not Field_Is_Initial_Zero (Old_N, F) + then + Write_Str ("# "); + Write_Str (Osint.Get_First_Main_File_Name); + Write_Str (": "); + Write_Str (Old_Kind'Img); + Write_Str (" --> "); + Write_Str (New_Kind'Img); + Write_Str (" Nonzero field "); + Write_Str (F'Img); + Write_Str (" is vanishing "); + + if New_Kind = E_Void or else Old_Kind = E_Void then + Write_Line ("(E_Void case)"); + else + Write_Line ("(non-E_Void case)"); end if; + + Write_Str (" ...mutating node "); + Write_Int (Nat (Old_N)); + Write_Line (""); + raise Program_Error; end if; end; end loop; |