-- the latter case it is critical to make a call to Set_RTU_Loaded to
-- ensure that the entry in this table reflects the load.
- -- Withed is True if an implicit with_clause has been added from some unit
- -- other than the main unit to this unit. Withed_By_Main is the same,
- -- except from the main unit.
+ -- A unit retrieved through rtsfind may end up in the context of several
+ -- other units, in addition to the main unit. These additional with_clauses
+ -- are needed to generate a proper traversal order for Inspector. To
+ -- minimize somewhat the redundancy created by numerous calls to rtsfind
+ -- from different units, we keep track of the list of implicit with_clauses
+ -- already created for the current loaded unit.
type RT_Unit_Table_Record is record
- Entity : Entity_Id;
- Uname : Unit_Name_Type;
- Unum : Unit_Number_Type;
- Withed : Boolean;
- Withed_By_Main : Boolean;
+ Entity : Entity_Id;
+ Uname : Unit_Name_Type;
+ First_Implicit_With : Node_Id;
+ Unum : Unit_Number_Type;
end record;
RT_Unit_Table : array (RTU_Id) of RT_Unit_Table_Record;
-- When a unit is implicitly loaded as a result of a call to RTE, it is
-- necessary to create one or two implicit with_clauses. We add such
-- with_clauses to the extended main unit if needed, and also to whatever
- -- unit first needs them, which is not necessarily the main unit. The
- -- former ensures that the object is correctly loaded by the binder. The
- -- latter is necessary for SofCheck Inspector.
+ -- unit needs them, which is not necessarily the main unit. The former
+ -- ensures that the object is correctly loaded by the binder. The latter
+ -- is necessary for SofCheck Inspector.
- -- The flags Withed and Withed_By_Main in the unit table record are used to
- -- avoid duplicates.
+ -- The field First_Implicit_With in the unit table record are used to
+ -- avoid creating duplicate with_clauses.
-----------------------
-- Local Subprograms --
-- Otherwise we need to load the unit, First build unit name
-- from the enumeration literal name in type RTU_Id.
- U.Uname := Get_Unit_Name (U_Id);
- U.Withed := False;
- U.Withed_By_Main := False;
+ U.Uname := Get_Unit_Name (U_Id);
+ U. First_Implicit_With := Empty;
-- Now do the load call, note that setting Error_Node to Empty is
-- a signal to Load_Unit that we will regard a failure to find the
--------------------
procedure Maybe_Add_With (U : in out RT_Unit_Table_Record) is
- Is_Main : constant Boolean :=
- In_Extended_Main_Code_Unit (Cunit_Entity (Current_Sem_Unit));
-
begin
-- We do not need to generate a with_clause for a call issued from
-- RTE_Component_Available. However, for Inspector, we need these
return;
end if;
- -- If the current unit is the main one, add the with_clause unless it's
- -- already been done.
+ -- Add the with_clause, if not already in the context of the
+ -- current compilation unit.
- if Is_Main then
- if U.Withed_By_Main then
- return;
- else
- U.Withed_By_Main := True;
- end if;
+ declare
+ LibUnit : constant Node_Id := Unit (Cunit (U.Unum));
+ Clause : Node_Id;
+ Withn : Node_Id;
- -- If the current unit is not the main one, add the with_clause unless
- -- it's already been done for some non-main unit.
+ begin
+ Clause := U.First_Implicit_With;
+ while Present (Clause) loop
+ if Parent (Clause) = Cunit (Current_Sem_Unit) then
+ return;
+ end if;
- else
- if U.Withed then
- return;
- else
- U.Withed := True;
- end if;
- end if;
+ Clause := Next_Implicit_With (Clause);
+ end loop;
- -- Here if we've decided to add the with_clause
+ Withn :=
+ Make_With_Clause (Standard_Location,
+ Name =>
+ Make_Unit_Name
+ (U, Defining_Unit_Name (Specification (LibUnit))));
- declare
- LibUnit : constant Node_Id := Unit (Cunit (U.Unum));
- Withn : constant Node_Id :=
- Make_With_Clause (Standard_Location,
- Name =>
- Make_Unit_Name
- (U, Defining_Unit_Name (Specification (LibUnit))));
+ Set_Library_Unit (Withn, Cunit (U.Unum));
+ Set_Corresponding_Spec (Withn, U.Entity);
+ Set_First_Name (Withn, True);
+ Set_Implicit_With (Withn, True);
+ Set_Next_Implicit_With (Withn, U.First_Implicit_With);
- begin
- Set_Library_Unit (Withn, Cunit (U.Unum));
- Set_Corresponding_Spec (Withn, U.Entity);
- Set_First_Name (Withn, True);
- Set_Implicit_With (Withn, True);
+ U.First_Implicit_With := Withn;
Mark_Rewrite_Insertion (Withn);
Append (Withn, Context_Items (Cunit (Current_Sem_Unit)));
-- The RT_Unit_Table entry that may need updating
begin
- -- If entry is not set, set it now
+ -- If entry is not set, set it now, and indicate that it
+ -- was loaded through an explicit context clause..
if No (U.Entity) then
- U := (Entity => E,
- Uname => Get_Unit_Name (U_Id),
- Unum => Unum,
- Withed => False,
- Withed_By_Main => False);
+ U := (Entity => E,
+ Uname => Get_Unit_Name (U_Id),
+ Unum => Unum,
+ First_Implicit_With => Empty);
end if;
return;
-- scope are chained, and this field is used as the forward pointer for
-- this list. See Einfo for further details.
+ -- Next_Implicit_With (Node3-Sem)
+ -- Present in N_With_Clause. Part of a chain of with_clauses generated
+ -- in rtsfind to indicate implicit dependencies on predefined units. Used
+ -- to prevent multiple with_clauses for the same unit in a given context.
+ -- A postorder traversal of the tree whose nodes are units and whose
+ -- links are with_clauses defines the order in which Inspector must
+ -- examine a compiled unit and its full context. This ordering ensures
+ -- that any subprogram call is examined after the subprogram declartion
+ -- has been seen.
+
-- Next_Named_Actual (Node4-Sem)
-- Present in parameter association node. Set during semantic analysis to
-- point to the next named parameter, where parameters are ordered by
-- N_With_Clause
-- Sloc points to first token of library unit name
-- Name (Node2)
+ -- Next_Implicit_With (Node3-Sem)
-- Library_Unit (Node4-Sem)
-- Corresponding_Spec (Node5-Sem)
-- First_Name (Flag5) (set to True if first name or only one name)
function Next_Entity
(N : Node_Id) return Node_Id; -- Node2
+ function Next_Implicit_With
+ (N : Node_Id) return Node_Id; -- Node3
+
function Next_Named_Actual
(N : Node_Id) return Node_Id; -- Node4
procedure Set_Next_Entity
(N : Node_Id; Val : Node_Id); -- Node2
+ procedure Set_Next_Implicit_With
+ (N : Node_Id; Val : Node_Id); -- Node3
+
procedure Set_Next_Named_Actual
(N : Node_Id; Val : Node_Id); -- Node4
pragma Inline (Name);
pragma Inline (Names);
pragma Inline (Next_Entity);
+ pragma Inline (Next_Implicit_With);
pragma Inline (Next_Named_Actual);
pragma Inline (Next_Pragma);
pragma Inline (Next_Rep_Item);
pragma Inline (Set_Name);
pragma Inline (Set_Names);
pragma Inline (Set_Next_Entity);
+ pragma Inline (Set_Next_Implicit_With);
pragma Inline (Set_Next_Named_Actual);
pragma Inline (Set_Next_Pragma);
pragma Inline (Set_Next_Rep_Item);
projects / platform / upstream / gcc.git / commitdiff