-- Verify that a stub is declared immediately within a compilation unit,
-- and not in an inner frame.
- procedure Expand_With_Clause (Item : Node_Id; Nam : Node_Id; N : Node_Id);
- -- When a child unit appears in a context clause, the implicit withs on
- -- parents are made explicit, and with clauses are inserted in the context
- -- clause before the one for the child. If a parent in the with_clause
- -- is a renaming, the implicit with_clause is on the renaming whose name
- -- is mentioned in the with_clause, and not on the package it renames.
- -- N is the compilation unit whose list of context items receives the
- -- implicit with_clauses.
-
procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id);
-- Generate cross-reference information for the parents of child units
-- and of subunits. N is a defining_program_unit_name, and P_Id is the
if Ada_Version >= Ada_95
and then In_Predefined_Renaming (U)
+ and then Comes_From_Source (N)
then
if Restriction_Check_Required (No_Obsolescent_Features) then
Check_Restriction (No_Obsolescent_Features, N);
-- set when Ent is a tagged type and its class-wide type needs to appear
-- in the tree.
+ procedure Expand_With_Clause (Item : Node_Id; Nam : Node_Id; N : Node_Id);
+ -- When a child unit appears in a context clause, the implicit withs on
+ -- parents are made explicit, and with clauses are inserted in the context
+ -- clause before the one for the child. If a parent in the with_clause
+ -- is a renaming, the implicit with_clause is on the renaming whose name
+ -- is mentioned in the with_clause, and not on the package it renames.
+ -- N is the compilation unit whose list of context items receives the
+ -- implicit with_clauses.
+
procedure Install_Context (N : Node_Id; Chain : Boolean := True);
-- Installs the entities from the context clause of the given compilation
-- unit into the visibility chains. This is done before analyzing a unit.
with Table;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
+with Uname; use Uname;
with Warnsw; use Warnsw;
package body Sem_Ch8 is
begin
pragma Assert (Nkind (Clause) = N_Use_Package_Clause);
+
+ -- Perform "use implies with" expansion (when extensions are enabled)
+ -- by inserting an extra with clause since redundant clauses don't
+ -- really matter.
+
+ if All_Extensions_Allowed and then Is_In_Context_Clause (Clause) then
+ declare
+ Unum : Unit_Number_Type;
+ With_Clause : constant Node_Id :=
+ Make_With_Clause (Sloc (Clause),
+ Name => New_Copy_Tree (Pack));
+ begin
+ -- Attempt to load the unit mentioned in the use clause
+
+ Unum := Load_Unit
+ (Load_Name => Get_Unit_Name (With_Clause),
+ Required => False,
+ Subunit => False,
+ Error_Node => Clause,
+ With_Node => With_Clause);
+
+ -- Either we can't file the unit or the use clause is a
+ -- reference to a nested package - in that case just handle
+ -- the use clause normally.
+
+ if Unum /= No_Unit then
+
+ Set_Library_Unit (With_Clause, Cunit (Unum));
+ Set_Is_Implicit_With (With_Clause);
+
+ Analyze (With_Clause);
+ Expand_With_Clause
+ (With_Clause, Name (With_Clause),
+ Enclosing_Comp_Unit_Node (Clause));
+ end if;
+ end;
+ end if;
+
Analyze (Pack);
-- Verify that the package standard is not directly named in a
-- Determines if the placement of the current pragma is appropriate
-- for a configuration pragma.
- function Is_In_Context_Clause return Boolean;
- -- Returns True if pragma appears within the context clause of a unit,
- -- and False for any other placement (does not generate any messages).
-
function Is_Static_String_Expression (Arg : Node_Id) return Boolean;
-- Analyzes the argument, and determines if it is a static string
-- expression, returns True if so, False if non-static or not String.
-- Check case of appearing within context clause
- if not Is_Unused and then Is_In_Context_Clause then
+ if not Is_Unused and then Is_In_Context_Clause (N) then
-- The arguments must all be units mentioned in a with clause in
-- the same context clause. Note that Par.Prag already checked
end if;
end Is_Configuration_Pragma;
- --------------------------
- -- Is_In_Context_Clause --
- --------------------------
-
- function Is_In_Context_Clause return Boolean is
- Plist : List_Id;
- Parent_Node : Node_Id;
-
- begin
- if Is_List_Member (N) then
- Plist := List_Containing (N);
- Parent_Node := Parent (Plist);
-
- return Present (Parent_Node)
- and then Nkind (Parent_Node) = N_Compilation_Unit
- and then Context_Items (Parent_Node) = Plist;
- end if;
-
- return False;
- end Is_In_Context_Clause;
-
---------------------------------
-- Is_Static_String_Expression --
---------------------------------
begin
-- Pragma must be in context items list of a compilation unit
- if not Is_In_Context_Clause then
+ if not Is_In_Context_Clause (N) then
Pragma_Misplaced;
end if;
-- Pragma must be in context items list of a compilation unit
- if not Is_In_Context_Clause then
+ if not Is_In_Context_Clause (N) then
Pragma_Misplaced;
end if;
return Nkind (Spec_Decl) in N_Generic_Declaration;
end Is_Generic_Declaration_Or_Body;
+ --------------------------
+ -- Is_In_Context_Clause --
+ --------------------------
+
+ function Is_In_Context_Clause (N : Node_Id) return Boolean is
+ Plist : List_Id;
+ Parent_Node : Node_Id;
+
+ begin
+ if Is_List_Member (N) then
+ Plist := List_Containing (N);
+ Parent_Node := Parent (Plist);
+
+ return Present (Parent_Node)
+ and then Nkind (Parent_Node) = N_Compilation_Unit
+ and then Context_Items (Parent_Node) = Plist;
+ end if;
+
+ return False;
+ end Is_In_Context_Clause;
+
---------------------------
-- Is_Independent_Object --
---------------------------
-- Determine whether arbitrary declaration Decl denotes a generic package,
-- a generic subprogram or a generic body.
+ function Is_In_Context_Clause (N : Node_Id) return Boolean;
+ -- Returns True if N appears within the context clause of a unit, and False
+ -- for any other placement.
+
function Is_Independent_Object (N : Node_Id) return Boolean;
-- Determine whether arbitrary node N denotes a reference to an independent
-- object as per RM C.6(8).
projects / thirdparty / gcc.git / commitdiff
