Index: csinfo.adb =================================================================== --- csinfo.adb (revision 186067) +++ csinfo.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- 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); Index: sinfo.adb =================================================================== --- sinfo.adb (revision 186067) +++ sinfo.adb (working copy) @@ -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 Index: sinfo.ads =================================================================== --- sinfo.ads (revision 186076) +++ sinfo.ads (working copy) @@ -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); Index: lib-writ.adb =================================================================== --- lib-writ.adb (revision 186067) +++ lib-writ.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- 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; Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 186070) +++ sem_ch12.adb (working copy) @@ -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; Index: ali.adb =================================================================== --- ali.adb (revision 186067) +++ ali.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- 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 Index: ali.ads =================================================================== --- ali.ads (revision 186067) +++ ali.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- 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 (