From 14bf9f7bb7fe6176532414093f9a5084bbd41428 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 8 Mar 2023 12:15:13 -0500 Subject: [PATCH] ada: Switch from E_Void to Is_Not_Self_Hidden We had previously used Ekind = E_Void to indicate that a declaration is self-hidden. We now use the Is_Not_Self_Hidden flag instead. This allows us to avoid many "vanishing fields", which are (possibly-latent) bugs, and we now enable the assertions in Atree that detect such bugs. gcc/ada/ * atree.adb (Check_Vanishing_Fields): Fix bug in the "blah type only" cases. Remove the special cases for E_Void. Misc cleanup. (Mutate_Nkind): Disallow mutating to the same kind. (Mutate_Ekind): Disallow mutating to E_Void. (From E_Void is still OK -- entities start out as E_Void by default.) Fix bug in statistics gathering -- was setting the wrong count. Enable Check_Vanishing_Fields for entities. * sem_ch8.adb (Is_Self_Hidden): New function. (Find_Direct_Name): Call Is_Self_Hidden to use the new Is_Not_Self_Hidden flag to determine whether a declaration is hidden from all visibility by itself. This replaces the old method of checking E_Void. (Find_Expanded_Name): Likewise. (Find_Selected_Component): Likewise. * sem_util.adb (Enter_Name): Remove setting of Ekind to E_Void. * sem_ch3.adb: Set the Is_Not_Self_Hidden flag in appropriate places. Comment fixes. (Inherit_Component): Remove setting of Ekind to E_Void. * sem_ch9.adb (Analyze_Protected_Type_Declaration): Update comment. Skip Itypes, which should not be turned into components. * atree.ads (Mutate_Nkind): Document error case. (Mutate_Ekind): Remove comments apologizing for E_Void mutations. Document error cases. --- gcc/ada/atree.adb | 36 ++++++++++++------------------------ gcc/ada/atree.ads | 15 +++++++-------- gcc/ada/sem_ch3.adb | 50 ++++++++++++++++++++++++-------------------------- gcc/ada/sem_ch8.adb | 34 +++++++++++++++++++++------------- gcc/ada/sem_ch9.adb | 10 ++++++---- gcc/ada/sem_util.adb | 6 +----- 6 files changed, 71 insertions(+), 80 deletions(-) diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index ef19a80b6e7..f1e4e2ca8bb 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -25,10 +25,10 @@ with Ada.Unchecked_Conversion; with Aspects; use Aspects; -with Debug; use Debug; with Namet; use Namet; with Nlists; use Nlists; with Opt; use Opt; +with Osint; with Output; use Output; with Sinfo.Utils; use Sinfo.Utils; with System.Storage_Elements; @@ -975,8 +975,6 @@ package body Atree is end loop; end Check_Vanishing_Fields; - Check_Vanishing_Fields_Failed : Boolean := False; - procedure Check_Vanishing_Fields (Old_N : Entity_Id; New_Kind : Entity_Kind) is @@ -1012,16 +1010,9 @@ package body Atree is when others => return False; -- ignore the exception end Same_Node_To_Fetch_From; - begin - -- Disable these checks in the case of converting to or from E_Void, - -- because we have many cases where we convert something to E_Void and - -- then back (or then to something else), and Reinit_Field_To_Zero - -- wouldn't work because we expect the fields to retain their values. - - if New_Kind = E_Void or else Old_Kind = E_Void then - return; - end if; + -- 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); @@ -1030,8 +1021,9 @@ package body Atree is 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 - Check_Vanishing_Fields_Failed := True; Write_Str ("# "); + Write_Str (Osint.Get_First_Main_File_Name); + Write_Str (": "); Write_Str (Old_Kind'Img); Write_Str (" --> "); Write_Str (New_Kind'Img); @@ -1048,14 +1040,11 @@ package body Atree is Write_Str (" ...mutating node "); Write_Int (Nat (Old_N)); Write_Line (""); + raise Program_Error; end if; end if; end; end loop; - - if Check_Vanishing_Fields_Failed then - raise Program_Error; - end if; end Check_Vanishing_Fields; Nkind_Offset : constant Field_Offset := Field_Descriptors (F_Nkind).Offset; @@ -1080,6 +1069,8 @@ package body Atree is All_Node_Offsets : Node_Offsets.Table_Type renames Node_Offsets.Table (Node_Offsets.First .. Node_Offsets.Last); begin + pragma Assert (Nkind (N) /= Val); + pragma Debug (Check_Vanishing_Fields (N, Val)); -- Grow the slots if necessary @@ -1131,23 +1122,20 @@ package body Atree is procedure Set_Entity_Kind_Type is new Set_8_Bit_Field (Entity_Kind) with Inline; - procedure Mutate_Ekind - (N : Entity_Id; Val : Entity_Kind) - is + procedure Mutate_Ekind (N : Entity_Id; Val : Entity_Kind) is begin if Ekind (N) = Val then return; end if; - if Debug_Flag_Underscore_V then - pragma Debug (Check_Vanishing_Fields (N, Val)); - end if; + pragma Assert (Val /= E_Void); + pragma Debug (Check_Vanishing_Fields (N, Val)); -- For now, we are allocating all entities with the same size, so we -- don't need to reallocate slots here. if Atree_Statistics_Enabled then - Set_Count (F_Nkind) := Set_Count (F_Ekind) + 1; + Set_Count (F_Ekind) := Set_Count (F_Ekind) + 1; end if; Set_Entity_Kind_Type (N, Ekind_Offset, Val); diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 329e41954dd..abe5cc5f3b5 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -637,16 +637,15 @@ package Atree is -- Mutate_Nkind. This is necessary, because the memory occupied by the -- vanishing fields might be used for totally unrelated fields in the new -- node. See Reinit_Field_To_Zero. + -- + -- It is an error to mutate a node to the same kind it already has. - procedure Mutate_Ekind - (N : Entity_Id; Val : Entity_Kind) with Inline; + procedure Mutate_Ekind (N : Entity_Id; Val : Entity_Kind) with Inline; -- Ekind is also like a discriminant, and is mostly treated as above (see - -- Mutate_Nkind). However, there are a few cases where we set the Ekind - -- from its initial E_Void value to something else, then set it back to - -- E_Void, then back to the something else, and we expect the "something - -- else" fields to retain their value. The two "something else"s are not - -- always the same; for example we change from E_Void, to E_Variable, to - -- E_Void, to E_Constant. + -- Mutate_Nkind). + -- + -- It is not (yet?) an error to mutate an entity to the same kind it + -- already has. It is an error to mutate to E_Void. function Node_To_Fetch_From (N : Node_Or_Entity_Id; Field : Node_Or_Entity_Field) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index db2bbb5ee8e..1ed590ba519 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -7589,6 +7589,7 @@ package body Sem_Ch3 is end if; Mutate_Ekind (New_Lit, E_Enumeration_Literal); + Set_Is_Not_Self_Hidden (New_Lit); Set_Enumeration_Pos (New_Lit, Enumeration_Pos (Literal)); Set_Enumeration_Rep (New_Lit, Enumeration_Rep (Literal)); Set_Enumeration_Rep_Expr (New_Lit, Empty); @@ -8123,6 +8124,7 @@ package body Sem_Ch3 is Build_Derived_Type (N, Full_Parent, Full_Der, Is_Completion => False, Derive_Subps => False); + Set_Is_Not_Self_Hidden (Full_Der); end if; Set_Has_Private_Declaration (Full_Der); @@ -9917,8 +9919,8 @@ package body Sem_Ch3 is -- There is no completion for record extensions declared in the -- parameter part of a generic, so we need to complete processing for - -- these generic record extensions here. The Record_Type_Definition call - -- will change the Ekind of the components from E_Void to E_Component. + -- these generic record extensions here. Record_Type_Definition will + -- set the Is_Not_Self_Hidden flag. elsif Private_Extension and then Is_Generic_Type (Derived_Type) then Record_Type_Definition (Empty, Derived_Type); @@ -11959,6 +11961,8 @@ package body Sem_Ch3 is return; end if; + Set_Is_Not_Self_Hidden (Typ); + Comp := First (Component_Items (Comp_List)); while Present (Comp) loop if Nkind (Comp) = N_Component_Declaration then @@ -12930,13 +12934,14 @@ package body Sem_Ch3 is -- Set common attributes for all subtypes: kind, convention, etc. - Mutate_Ekind (Full, Subtype_Kind (Ekind (Full_Base))); - Set_Convention (Full, Convention (Full_Base)); + Mutate_Ekind (Full, Subtype_Kind (Ekind (Full_Base))); + Set_Is_Not_Self_Hidden (Full); + Set_Convention (Full, Convention (Full_Base)); Set_Is_First_Subtype (Full, False); - Set_Scope (Full, Scope (Priv)); - Set_Size_Info (Full, Full_Base); - Copy_RM_Size (To => Full, From => Full_Base); - Set_Is_Itype (Full); + Set_Scope (Full, Scope (Priv)); + Set_Size_Info (Full, Full_Base); + Copy_RM_Size (To => Full, From => Full_Base); + Set_Is_Itype (Full); -- A subtype of a private-type-without-discriminants, whose full-view -- has discriminants with default expressions, is not constrained. @@ -15094,6 +15099,7 @@ package body Sem_Ch3 is -- in the private part is the full declaration. Exchange_Entities (Priv, Full); + Set_Is_Not_Self_Hidden (Priv); Append_Entity (Full, Scope (Full)); end Copy_And_Swap; @@ -16046,6 +16052,7 @@ package body Sem_Ch3 is begin New_Subp := New_Entity (Nkind (Parent_Subp), Sloc (Derived_Type)); Mutate_Ekind (New_Subp, Ekind (Parent_Subp)); + Set_Is_Not_Self_Hidden (New_Subp); -- Check whether the inherited subprogram is a private operation that -- should be inherited but not yet made visible. Such subprograms can @@ -17662,6 +17669,8 @@ package body Sem_Ch3 is -- Avoid deriving parent primitives of underlying record views + Set_Is_Not_Self_Hidden (T); + Build_Derived_Type (N, Parent_Type, T, Is_Completion, Derive_Subps => not Is_Underlying_Record_View (T)); @@ -17750,6 +17759,7 @@ package body Sem_Ch3 is while Present (L) loop if Ekind (L) /= E_Enumeration_Literal then Mutate_Ekind (L, E_Enumeration_Literal); + Set_Is_Not_Self_Hidden (L); Set_Enumeration_Pos (L, Ev); Set_Enumeration_Rep (L, Ev); Set_Is_Known_Valid (L, True); @@ -19197,22 +19207,6 @@ package body Sem_Ch3 is end if; end if; - -- In derived tagged types it is illegal to reference a non - -- discriminant component in the parent type. To catch this, mark - -- these components with an Ekind of E_Void. This will be reset in - -- Record_Type_Definition after processing the record extension of - -- the derived type. - - -- If the declaration is a private extension, there is no further - -- record extension to process, and the components retain their - -- current kind, because they are visible at this point. - - if Is_Tagged and then Ekind (New_C) = E_Component - and then Nkind (N) /= N_Private_Extension_Declaration - then - Mutate_Ekind (New_C, E_Void); - end if; - if Plain_Discrim then Set_Corresponding_Discriminant (New_C, Old_C); Build_Discriminal (New_C); @@ -20222,6 +20216,7 @@ package body Sem_Ch3 is Op := Make_Defining_Operator_Symbol (Loc, Name_Op_Concat); Mutate_Ekind (Op, E_Operator); + Set_Is_Not_Self_Hidden (Op); Set_Scope (Op, Current_Scope); Set_Etype (Op, Typ); Set_Homonym (Op, Get_Name_Entity_Id (Name_Op_Concat)); @@ -20940,6 +20935,7 @@ package body Sem_Ch3 is end if; Mutate_Ekind (Id, E_Discriminant); + Set_Is_Not_Self_Hidden (Id); Reinit_Component_Location (Id); Reinit_Esize (Id); Set_Discriminant_Number (Id, Discr_Number); @@ -22762,6 +22758,8 @@ package body Sem_Ch3 is T := Prev_T; end if; + Set_Is_Not_Self_Hidden (T); + Final_Storage_Only := not Is_Controlled (T); -- Ada 2005: Check whether an explicit "limited" is present in a derived @@ -22803,6 +22801,7 @@ package body Sem_Ch3 is then Mutate_Ekind (Component, E_Component); Reinit_Component_Location (Component); + Set_Is_Not_Self_Hidden (Component); end if; Propagate_Concurrent_Flags (T, Etype (Component)); @@ -23022,9 +23021,8 @@ package body Sem_Ch3 is -- Reset the kind of the subtype during analysis of the range, to -- catch possible premature use in the bounds themselves. - Mutate_Ekind (Def_Id, E_Void); Process_Range_Expr_In_Decl (R, Subt, Subtyp => Def_Id); - Mutate_Ekind (Def_Id, Kind); + pragma Assert (Ekind (Def_Id) = Kind); end Set_Scalar_Range_For_Subtype; -------------------------------------------------------- diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 212c13e12fd..6e0db366db8 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -536,6 +536,11 @@ package body Sem_Ch8 is procedure Premature_Usage (N : Node_Id); -- Diagnose usage of an entity before it is visible + function Is_Self_Hidden (E : Entity_Id) return Boolean; + -- True within a declaration if it is hidden from all visibility by itself + -- (see RM-8.3(16-18)). This is mostly just "not Is_Not_Self_Hidden", but + -- we need to check for E_Void in case of errors. + procedure Use_One_Package (N : Node_Id; Pack_Name : Entity_Id := Empty; @@ -5455,6 +5460,19 @@ package body Sem_Ch8 is end case; end Error_Missing_With_Of_Known_Unit; + -------------------- + -- Is_Self_Hidden -- + -------------------- + + function Is_Self_Hidden (E : Entity_Id) return Boolean is + begin + if Is_Not_Self_Hidden (E) then + return Ekind (E) = E_Void; + else + return True; + end if; + end Is_Self_Hidden; + ---------------------- -- Find_Direct_Name -- ---------------------- @@ -6443,14 +6461,7 @@ package body Sem_Ch8 is Write_Entity_Info (E, " "); end if; - -- If the Ekind of the entity is Void, it means that all homonyms - -- are hidden from all visibility (RM 8.3(5,14-20)). However, this - -- test is skipped if the current scope is a record and the name is - -- a pragma argument expression (case of Atomic and Volatile pragmas - -- and possibly other similar pragmas added later, which are allowed - -- to reference components in the current record). - - if Ekind (E) = E_Void + if Is_Self_Hidden (E) and then (not Is_Record_Type (Current_Scope) or else Nkind (Parent (N)) /= N_Pragma_Argument_Association) @@ -7202,10 +7213,7 @@ package body Sem_Ch8 is Check_Wide_Character_Restriction (Id, N); - -- If the Ekind of the entity is Void, it means that all homonyms are - -- hidden from all visibility (RM 8.3(5,14-20)). - - if Ekind (Id) = E_Void then + if Is_Self_Hidden (Id) then Premature_Usage (N); elsif Is_Overloadable (Id) and then Present (Homonym (Id)) then @@ -8148,7 +8156,7 @@ package body Sem_Ch8 is end loop; end; - elsif Ekind (P_Name) = E_Void then + elsif Is_Self_Hidden (P_Name) then Premature_Usage (P); elsif Ekind (P_Name) = E_Generic_Package then diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index a15e37b7ce7..72821c51c3f 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -2181,14 +2181,16 @@ package body Sem_Ch9 is Set_Has_Controlled_Component (T, True); end if; - -- The Ekind of components is E_Void during analysis to detect illegal - -- uses. Now it can be set correctly. + -- The Ekind of components is E_Void during analysis for historical + -- reasons. Now it can be set correctly. E := First_Entity (Current_Scope); while Present (E) loop if Ekind (E) = E_Void then - Mutate_Ekind (E, E_Component); - Reinit_Component_Location (E); + if not Is_Itype (E) then + Mutate_Ekind (E, E_Component); + Reinit_Component_Location (E); + end if; end if; Next_Entity (E); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index c9aa76707a5..6b5abc92c96 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8220,12 +8220,8 @@ package body Sem_Util is elsif Present (Etype (Def_Id)) then null; - -- Otherwise, the kind E_Void insures that premature uses of the entity - -- will be detected. Any_Type insures that no cascaded errors will occur - else - Mutate_Ekind (Def_Id, E_Void); - Set_Etype (Def_Id, Any_Type); + Set_Etype (Def_Id, Any_Type); -- avoid cascaded errors end if; -- All entities except Itypes are immediately visible -- 2.11.4.GIT