[gcc r14-1223] ada: Switch from E_Void to Is_Not_Self_Hidden
Marc Poulhi?s
dkm@gcc.gnu.org
Thu May 25 08:06:49 GMT 2023
https://gcc.gnu.org/g:14bf9f7bb7fe6176532414093f9a5084bbd41428
commit r14-1223-g14bf9f7bb7fe6176532414093f9a5084bbd41428
Author: Bob Duff <duff@adacore.com>
Date: Wed Mar 8 12:15:13 2023 -0500
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.
Diff:
---
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
More information about the Gcc-cvs
mailing list