===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -218,6 +218,7 @@
Set (Special, "Has_Dynamic_Range_Check", True);
Set (Special, "Has_Dynamic_Length_Check", True);
Set (Special, "Has_Private_View", True);
+ Set (Special, "Implicit_With_From_Instantiation", True);
Set (Special, "Is_Controlling_Actual", True);
Set (Special, "Is_Overloaded", True);
Set (Special, "Is_Static_Expression", True);
===================================================================
@@ -1624,6 +1624,14 @@
return Flag16 (N);
end Implicit_With;
+ function Implicit_With_From_Instantiation
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_With_Clause);
+ return Flag12 (N);
+ end Implicit_With_From_Instantiation;
+
function Interface_List
(N : Node_Id) return List_Id is
begin
@@ -4704,6 +4712,14 @@
Set_Flag16 (N, Val);
end Set_Implicit_With;
+ procedure Set_Implicit_With_From_Instantiation
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_With_Clause);
+ Set_Flag12 (N, Val);
+ end Set_Implicit_With_From_Instantiation;
+
procedure Set_Interface_List
(N : Node_Id; Val : List_Id) is
begin
===================================================================
@@ -1226,6 +1226,9 @@
-- 'Address or 'Tag attribute. ???There are other implicit with clauses
-- as well.
+ -- Implicit_With_From_Instantiation (Flag12-Sem)
+ -- Set in N_With_Clause nodes from generic instantiations.
+
-- Import_Interface_Present (Flag16-Sem)
-- This flag is set in an Interface or Import pragma if a matching
-- pragma of the other kind is also present. This is used to avoid
@@ -5805,6 +5808,7 @@
-- Elaborate_Desirable (Flag11-Sem)
-- Private_Present (Flag15) set if with_clause has private keyword
-- Implicit_With (Flag16-Sem)
+ -- Implicit_With_From_Instantiation (Flag12-Sem)
-- Limited_Present (Flag17) set if LIMITED is present
-- Limited_View_Installed (Flag18-Sem)
-- Unreferenced_In_Spec (Flag7-Sem)
@@ -8592,6 +8596,9 @@
function Implicit_With
(N : Node_Id) return Boolean; -- Flag16
+ function Implicit_With_From_Instantiation
+ (N : Node_Id) return Boolean; -- Flag12
+
function Import_Interface_Present
(N : Node_Id) return Boolean; -- Flag16
@@ -9573,6 +9580,9 @@
procedure Set_Implicit_With
(N : Node_Id; Val : Boolean := True); -- Flag16
+ procedure Set_Implicit_With_From_Instantiation
+ (N : Node_Id; Val : Boolean := True); -- Flag12
+
procedure Set_Import_Interface_Present
(N : Node_Id; Val : Boolean := True); -- Flag16
@@ -11959,6 +11969,7 @@
pragma Inline (High_Bound);
pragma Inline (Identifier);
pragma Inline (Implicit_With);
+ pragma Inline (Implicit_With_From_Instantiation);
pragma Inline (Interface_List);
pragma Inline (Interface_Present);
pragma Inline (Includes_Infinities);
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -196,6 +196,10 @@
Elab_All_Des_Flags : array (Units.First .. Last_Unit) of Boolean;
-- Array of flags to show which units have Elaborate_All_Desirable set
+ type Yes_No is (Unknown, Yes, No);
+
+ Implicit_With : array (Units.First .. Last_Unit) of Yes_No;
+
Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2));
-- Sorted table of source dependencies. One extra entry in case we
-- have to add a dummy entry for System.
@@ -276,6 +280,15 @@
else
Set_From_With_Type (Cunit_Entity (Unum));
end if;
+
+ if Implicit_With (Unum) /= Yes then
+ if Implicit_With_From_Instantiation (Item) then
+ Implicit_With (Unum) := Yes;
+
+ else
+ Implicit_With (Unum) := No;
+ end if;
+ end if;
end if;
Next (Item);
@@ -552,6 +565,7 @@
Elab_All_Flags (J) := False;
Elab_Des_Flags (J) := False;
Elab_All_Des_Flags (J) := False;
+ Implicit_With (J) := Unknown;
end loop;
Collect_Withs (Unode);
@@ -770,10 +784,14 @@
Uname := Units.Table (Unum).Unit_Name;
Fname := Units.Table (Unum).Unit_File_Name;
- if Ekind (Cunit_Entity (Unum)) = E_Package
+ if Implicit_With (Unum) = Yes then
+ Write_Info_Initiate ('Z');
+
+ elsif Ekind (Cunit_Entity (Unum)) = E_Package
and then From_With_Type (Cunit_Entity (Unum))
then
Write_Info_Initiate ('Y');
+
else
Write_Info_Initiate ('W');
end if;
===================================================================
@@ -7761,6 +7761,9 @@
Item : Node_Id;
New_I : Node_Id;
+ Clause : Node_Id;
+ OK : Boolean;
+
begin
if Nkind (Parent (Gen_Decl)) = N_Compilation_Unit then
@@ -7782,17 +7785,30 @@
while Present (Item) loop
if Nkind (Item) = N_With_Clause then
- -- Take care to prevent direct cyclic with's, which can happen
- -- if the generic body with's the current unit. Such a case
- -- would result in binder errors (or run-time errors if the
- -- -gnatE switch is in effect), but we want to prevent it here,
- -- because Sem.Walk_Library_Items doesn't like cycles. Note
- -- that we don't bother to detect indirect cycles.
+ -- Take care to prevent direct cyclic with's.
if Library_Unit (Item) /= Current_Unit then
- New_I := New_Copy (Item);
- Set_Implicit_With (New_I, True);
- Append (New_I, Current_Context);
+ -- Do not add a unit if it is already in the context
+
+ Clause := First (Current_Context);
+ OK := True;
+ while Present (Clause) loop
+ if Nkind (Clause) = N_With_Clause and then
+ Chars (Name (Clause)) = Chars (Name (Item))
+ then
+ OK := False;
+ exit;
+ end if;
+
+ Next (Clause);
+ end loop;
+
+ if OK then
+ New_I := New_Copy (Item);
+ Set_Implicit_With (New_I, True);
+ Set_Implicit_With_From_Instantiation (New_I, True);
+ Append (New_I, Current_Context);
+ end if;
end if;
end if;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -55,6 +55,7 @@
'X' => True, -- xref
'S' => True, -- specific dispatching
'Y' => True, -- limited_with
+ 'Z' => True, -- implicit with from instantiation
'C' => True, -- SCO information
'F' => True, -- Alfa information
others => False);
@@ -782,7 +783,8 @@
-- Acquire lines to be ignored
if Read_Xref then
- Ignore := ('U' | 'W' | 'Y' | 'D' | 'X' => False, others => True);
+ Ignore :=
+ ('U' | 'W' | 'Y' | 'Z' | 'D' | 'X' => False, others => True);
-- Read_Lines parameter given
@@ -1717,7 +1719,7 @@
With_Loop : loop
Check_Unknown_Line;
- exit With_Loop when C /= 'W' and then C /= 'Y';
+ exit With_Loop when C /= 'W' and then C /= 'Y' and then C /= 'Z';
if Ignore ('W') then
Skip_Line;
@@ -1733,6 +1735,8 @@
Withs.Table (Withs.Last).Elab_All_Desirable := False;
Withs.Table (Withs.Last).SAL_Interface := False;
Withs.Table (Withs.Last).Limited_With := (C = 'Y');
+ Withs.Table (Withs.Last).Implicit_With_From_Instantiation
+ := (C = 'Z');
-- Generic case with no object file available
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -558,6 +558,9 @@
Limited_With : Boolean := False;
-- True if unit is named in a limited_with_clause
+
+ Implicit_With_From_Instantiation : Boolean := False;
+ -- True if this is an implicit with from a generic instantiation
end record;
package Withs is new Table.Table (