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;
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
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);
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);
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;
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
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);
-- 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)
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);
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);
-- 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);
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
-- 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.
-- 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;
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
-- 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));
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);
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);
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));
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);
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
then
Mutate_Ekind (Component, E_Component);
Reinit_Component_Location (Component);
+ Set_Is_Not_Self_Hidden (Component);
end if;
Propagate_Concurrent_Flags (T, Etype (Component));
-- 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;
--------------------------------------------------------
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;
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 --
----------------------
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)
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
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
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);
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
git://gcc.gnu.org / gcc.git / commitdiff