[multiple changes]

2009-04-24  Emmanuel Briot  <briot@adacore.com>

	* prj.adb, prj.ads, prj-nmsc.adb (Check_File, Record_Ada_Source,
	Add_Source): merge some code between those. In particular change where
	file normalization is done to avoid a few extra calls to
	Canonicalize_File_Name. This also removes the need for passing
	Current_Dir in a number of subprograms.

2009-04-24  Bob Duff  <duff@adacore.com>

	* lib-load.adb (Make_Instance_Unit): In the case where In_Main is
	False, assign the correct unit to the Cunit field of the new table
	entry. We want the spec unit, not the body unit.

	* rtsfind.adb (Make_Unit_Name, Maybe_Add_With): Simplify calling
	interface for these.
	(Maybe_Add_With): Check whether we're trying to a with on the current
	unit, and avoid creating such directly self-referential with clauses.
	(Text_IO_Kludge): Add implicit with's for the generic pseudo-children of
	[[Wide_]Wide_]Text_IO. These are needed for Walk_Library_Items,
	and matches existing comments in the spec.

	* sem.adb (Walk_Library_Items): Add various special cases to make the
	assertions pass.

	* sem_ch12.adb (Build_Instance_Compilation_Unit_Nodes): Use Body_Cunit
	instead of Parent (N), for uniformity.

From-SVN: r146724

gcc/ada/ChangeLog

+2009-04-24  Emmanuel Briot  <briot@adacore.com>
+
+	* prj.adb, prj.ads, prj-nmsc.adb (Check_File, Record_Ada_Source,
+	Add_Source): merge some code between those. In particular change where
+	file normalization is done to avoid a few extra calls to
+	Canonicalize_File_Name. This also removes the need for passing
+	Current_Dir in a number of subprograms.
+
+2009-04-24  Bob Duff  <duff@adacore.com>
+
+	* lib-load.adb (Make_Instance_Unit): In the case where In_Main is
+	False, assign the correct unit to the Cunit field of the new table
+	entry. We want the spec unit, not the body unit.
+
+	* rtsfind.adb (Make_Unit_Name, Maybe_Add_With): Simplify calling
+	interface for these.
+	(Maybe_Add_With): Check whether we're trying to a with on the current
+	unit, and avoid creating such directly self-referential with clauses.
+	(Text_IO_Kludge): Add implicit with's for the generic pseudo-children of
+	[[Wide_]Wide_]Text_IO. These are needed for Walk_Library_Items,
+	and matches existing comments in the spec.
+
+	* sem.adb (Walk_Library_Items): Add various special cases to make the
+	assertions pass.
+
+	* sem_ch12.adb (Build_Instance_Compilation_Unit_Nodes): Use Body_Cunit
+	instead of Parent (N), for uniformity.
+
 2009-04-24  Robert Dewar  <dewar@adacore.com>
 
 	* errout.ads: Minor reformatting

gcc/ada/lib-load.adb

@@ -812,7 +812,16 @@ package body Lib.Load is
          --  units table when first loaded as a declaration.
 
          Units.Table (Units.Last) := Units.Table (Get_Cunit_Unit_Number (N));
-         Units.Table (Units.Last).Cunit := N;
+
+         --  The correct Cunit is the spec -- Library_Unit (N). But that causes
+         --  gnatmake to fail in certain cases, so this is under control of
+         --  Inspector_Mode for now. ???
+
+         if Inspector_Mode then
+            Units.Table (Units.Last).Cunit := Library_Unit (N);
+         else
+            Units.Table (Units.Last).Cunit := N;
+         end if;
       end if;
    end Make_Instance_Unit;
 

gcc/ada/prj.adb

@@ -105,7 +105,6 @@ package body Prj is
                       Lib_Auto_Init                  => False,
                       Libgnarl_Needed                => Unknown,
                       Symbol_Data                    => No_Symbols,
-                      Ada_Sources                    => Nil_String,
                       Interfaces_Defined             => False,
                       Include_Path                   => null,
                       Include_Data_Set               => False,
@@ -1205,10 +1204,6 @@ package body Prj is
       Lang : Language_Ptr;
 
    begin
-      if Data.Ada_Sources /= Nil_String then
-         return True;
-      end if;
-
       Lang := Data.Languages;
       while Lang /= No_Language_Index loop
          if Lang.Name = Name_Ada then

gcc/ada/prj.ads

@@ -1256,11 +1256,8 @@ package Prj is
       -------------
       -- Sources --
       -------------
-      --  In multi-language mode, the sources for all languages including Ada
-      --  are accessible through the Source_Iterator type
-
-      Ada_Sources : String_List_Id := Nil_String;
-      --  The list of all the Ada source file names (gnatmake only).
+      --  The sources for all languages including Ada are accessible through
+      --  the Source_Iterator type
 
       Interfaces_Defined      : Boolean := False;
       --  True if attribute Interfaces is declared for the project or any

gcc/ada/rtsfind.adb

@@ -164,25 +164,26 @@ package body Rtsfind is
       Id          : RE_Id   := RE_Null;
       Use_Setting : Boolean := False);
    --  Load the unit whose Id is given if not already loaded. The unit is
-   --  loaded, analyzed, and added to the WITH list, and the entry in
-   --  RT_Unit_Table is updated to reflect the load. Use_Setting is used to
-   --  indicate the initial setting for the Is_Potentially_Use_Visible flag of
-   --  the entity for the loaded unit (if it is indeed loaded). A value of
-   --  False means nothing special need be done. A value of True indicates that
-   --  this flag must be set to True. It is needed only in the Text_IO_Kludge
-   --  procedure, which may materialize an entity of Text_IO (or
-   --  [Wide_]Wide_Text_IO) that was previously unknown. Id is the RE_Id value
-   --  of the entity which was originally requested. Id is used only for error
-   --  message detail, and if it is RE_Null, then the attempt to output the
-   --  entity name is ignored.
-
-   function Make_Unit_Name (E : RE_Id; N : Node_Id) return Node_Id;
+   --  loaded and analyzed, and the entry in RT_Unit_Table is updated to
+   --  reflect the load. Use_Setting is used to indicate the initial setting
+   --  for the Is_Potentially_Use_Visible flag of the entity for the loaded
+   --  unit (if it is indeed loaded). A value of False means nothing special
+   --  need be done. A value of True indicates that this flag must be set to
+   --  True. It is needed only in the Text_IO_Kludge procedure, which may
+   --  materialize an entity of Text_IO (or [Wide_]Wide_Text_IO) that was
+   --  previously unknown. Id is the RE_Id value of the entity which was
+   --  originally requested. Id is used only for error message detail, and if
+   --  it is RE_Null, then the attempt to output the entity name is ignored.
+
+   function Make_Unit_Name
+     (U : RT_Unit_Table_Record;
+      N : Node_Id) return Node_Id;
    --  If the unit is a child unit, build fully qualified name for use in
    --  With_Clause.
 
-   procedure Maybe_Add_With (E : RE_Id; U : in out RT_Unit_Table_Record);
+   procedure Maybe_Add_With (U : in out RT_Unit_Table_Record);
    --  If necessary, add an implicit with_clause from the current unit to the
-   --  one represented by E and U.
+   --  one represented by U.
 
    procedure Output_Entity_Name (Id : RE_Id; Msg : String);
    --  Output continuation error message giving qualified name of entity
@@ -765,9 +766,10 @@ package body Rtsfind is
    -- Make_Unit_Name --
    --------------------
 
-   function Make_Unit_Name (E : RE_Id; N : Node_Id) return Node_Id is
-      U_Id : constant RTU_Id := RE_Unit_Table (E);
-      U    : RT_Unit_Table_Record renames RT_Unit_Table (U_Id);
+   function Make_Unit_Name
+     (U : RT_Unit_Table_Record;
+      N : Node_Id) return Node_Id is
+
       Nam  : Node_Id;
       Scop : Entity_Id;
 
@@ -795,15 +797,24 @@ package body Rtsfind is
    -- Maybe_Add_With --
    --------------------
 
-   procedure Maybe_Add_With (E : RE_Id; U : in out RT_Unit_Table_Record) is
+   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.
+      --  RTE_Component_Available. However, for Inspector, we need these
+      --  additional with's, because for a sequence like "if RTE_Available (X)
+      --  then ... RTE (X)" the RTE call fails to create some necessary
+      --  with's.
 
-      if RTE_Available_Call then
+      if RTE_Available_Call and then not Inspector_Mode then
+         return;
+      end if;
+
+      --  Avoid creating directly self-referential with clauses
+
+      if Current_Sem_Unit = U.Unum then
          return;
       end if;
 
@@ -836,7 +847,7 @@ package body Rtsfind is
                      Make_With_Clause (Standard_Location,
                        Name =>
                          Make_Unit_Name
-                           (E, Defining_Unit_Name (Specification (LibUnit))));
+                           (U, Defining_Unit_Name (Specification (LibUnit))));
 
       begin
          Set_Library_Unit       (Withn, Cunit (U.Unum));
@@ -1127,7 +1138,7 @@ package body Rtsfind is
       end if;
 
    <<Found>>
-      Maybe_Add_With (E, U);
+      Maybe_Add_With (U);
 
       Front_End_Inlining := Save_Front_End_Inlining;
       return Check_CRT (E, RE_Table (E));
@@ -1229,7 +1240,7 @@ package body Rtsfind is
       --  If we didn't find the entity we want, something is wrong. The
       --  appropriate action will be taken by Check_CRT when we exit.
 
-      Maybe_Add_With (E, U);
+      Maybe_Add_With (U);
 
       Front_End_Inlining := Save_Front_End_Inlining;
       return Check_CRT (E, Found_E);
@@ -1380,6 +1391,9 @@ package body Rtsfind is
         Name_Integer_IO     => Ada_Wide_Wide_Text_IO_Integer_IO,
         Name_Modular_IO     => Ada_Wide_Wide_Text_IO_Modular_IO);
 
+      To_Load : RTU_Id;
+      --  Unit to be loaded, from one of the above maps
+
    begin
       --  Nothing to do if name is not an identifier or a selected component
       --  whose selector_name is not an identifier.
@@ -1419,27 +1433,27 @@ package body Rtsfind is
                --  they are visible.
 
                if Name_Buffer (1 .. 12) = "a-textio.ads" then
-                  Load_RTU
-                    (Name_Map (Chrs),
-                     Use_Setting => In_Use (Cunit_Entity (U)));
-                  Set_Is_Visible_Child_Unit
-                    (RT_Unit_Table (Name_Map (Chrs)).Entity);
+                  To_Load := Name_Map (Chrs);
 
                elsif Name_Buffer (1 .. 12) = "a-witeio.ads" then
-                  Load_RTU
-                    (Wide_Name_Map (Chrs),
-                     Use_Setting => In_Use (Cunit_Entity (U)));
-                  Set_Is_Visible_Child_Unit
-                    (RT_Unit_Table (Wide_Name_Map (Chrs)).Entity);
+                  To_Load := Wide_Name_Map (Chrs);
 
                elsif Name_Buffer (1 .. 12) = "a-ztexio.ads" then
-                  Load_RTU
-                    (Wide_Wide_Name_Map (Chrs),
-                     Use_Setting => In_Use (Cunit_Entity (U)));
-                  Set_Is_Visible_Child_Unit
-                    (RT_Unit_Table (Wide_Wide_Name_Map (Chrs)).Entity);
+                  To_Load := Wide_Wide_Name_Map (Chrs);
+
+               else
+                  goto Continue;
                end if;
+
+               Load_RTU
+                 (To_Load,
+                  Use_Setting => In_Use (Cunit_Entity (U)));
+               Set_Is_Visible_Child_Unit
+                 (RT_Unit_Table (To_Load).Entity);
+               Maybe_Add_With (RT_Unit_Table (To_Load));
             end if;
+
+            <<Continue>> null;
          end loop;
       end if;
 

gcc/ada/sem.adb

@@ -1544,7 +1544,8 @@ package body Sem is
             when N_Package_Body | N_Subprogram_Body =>
                --  A body must be the main unit
 
-               pragma Assert (CU = Cunit (Main_Unit));
+               pragma Assert (Acts_As_Spec (CU)
+                              or else CU = Cunit (Main_Unit));
                null;
 
             --  All other cases cannot happen
@@ -1573,29 +1574,32 @@ package body Sem is
                                 Get_Cunit_Unit_Number (CU);
 
                procedure Assert_Done (Withed_Unit : Node_Id);
-               --  Assert Withed_Unit is already Done
+               --  Assert Withed_Unit is already Done, unless it's a body. It
+               --  might seem strange for a with_clause to refer to a body, but
+               --  this happens in the case of a generic instantiation, which
+               --  gets transformed into the instance body (and the instance
+               --  spec is also created). With clauses pointing to the
+               --  instantiation end up pointing to the instance body.
 
                procedure Assert_Done (Withed_Unit : Node_Id) is
                begin
-                  if not Done
-                       (Get_Cunit_Unit_Number
-                        (Withed_Unit))
-                  then
-                     Write_Unit_Name
-                       (Unit_Name
-                        (Get_Cunit_Unit_Number
-                         (Withed_Unit)));
-                     Write_Str (" not yet walked!");
-                     Write_Eol;
-                  end if;
-
-                  if False then
-                     --  This assertion is disabled because it fails in the
-                     --  presence of subunits.
-                     pragma Assert  --  ???
-                       (Done
-                          (Get_Cunit_Unit_Number (Withed_Unit)));
-                     null;
+                  if not Done (Get_Cunit_Unit_Number (Withed_Unit)) then
+                     if not Nkind_In
+                       (Unit (Withed_Unit), N_Package_Body, N_Subprogram_Body)
+                     then
+
+                        Write_Unit_Name
+                          (Unit_Name
+                           (Get_Cunit_Unit_Number
+                            (Withed_Unit)));
+                        Write_Str (" not yet walked!");
+                        if Get_Cunit_Unit_Number (Withed_Unit) = Unit_Num then
+                           Write_Str (" (self-ref)");
+                        end if;
+                        Write_Eol;
+
+                        pragma Assert (False);
+                     end if;
                   end if;
                end Assert_Done;
 
@@ -1608,15 +1612,7 @@ package body Sem is
 
                --  Main unit should come last
 
-               if Done (Main_Unit) then
-                  Write_Line ("Main unit is done!");
-               end if;
-               if False then  --  ???
-                  --  This assertion is disabled because it fails in the
-                  --  presence of subunits.
-                  pragma Assert (not Done (Main_Unit));
-                  null;
-               end if;
+               pragma Assert (not Done (Main_Unit));
 
                --  We shouldn't do the same thing twice
 
@@ -1624,7 +1620,8 @@ package body Sem is
 
                --  Everything we depend upon should already be done
 
-               Assert_Withed_Units_Done (CU, Include_Limited => False);
+               pragma Debug
+                 (Assert_Withed_Units_Done (CU, Include_Limited => False));
             end;
 
          else
@@ -1645,8 +1642,8 @@ package body Sem is
       ----------------------------
 
       procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id) is
-         Unit_Num     : constant Unit_Number_Type :=
-                          Get_Cunit_Unit_Number (CU);
+         Unit_Num : constant Unit_Number_Type :=
+                      Get_Cunit_Unit_Number (CU);
 
          procedure Do_Withed_Unit (Withed_Unit : Node_Id);
          --  Pass the buck to Do_Unit_And_Dependents
@@ -1670,7 +1667,13 @@ package body Sem is
             declare
                Spec_Unit : constant Node_Id := Library_Unit (CU);
             begin
-               Do_Unit_And_Dependents (Spec_Unit, Unit (Spec_Unit));
+               if Spec_Unit = CU then  --  ???Why needed?
+                  pragma Assert (Acts_As_Spec (CU));
+                  null;
+
+               else
+                  Do_Unit_And_Dependents (Spec_Unit, Unit (Spec_Unit));
+               end if;
             end;
          end if;
 
@@ -1681,6 +1684,7 @@ package body Sem is
          --  Process the unit itself
 
          if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body)
+           or else Acts_As_Spec (CU)
            or else CU = Cunit (Main_Unit)
          then
 
@@ -1689,13 +1693,20 @@ package body Sem is
             Done (Unit_Num) := True;
          end if;
 
-         --  Process the corresponding body last
+         --  Process corresponding body of spec last. However, if this body is
+         --  the main unit (because some dependent of the main unit depends on
+         --  the main unit's spec), we don't process it now. We also skip
+         --  processing of the body of a unit named by pragma Extend_System,
+         --  because it has cyclic dependences in some cases.
 
          if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then
             declare
                Body_Unit : constant Node_Id := Library_Unit (CU);
             begin
-               if Present (Body_Unit) then
+               if Present (Body_Unit)
+                 and then Body_Unit /= Cunit (Main_Unit)
+                 and then Unit_Num /= Get_Source_Unit (System_Aux_Id)
+               then
                   Do_Unit_And_Dependents (Body_Unit, Unit (Body_Unit));
                end if;
             end;
@@ -1738,7 +1749,7 @@ package body Sem is
                      Entity : Node_Id := N;
 
                   begin
-                     if Nkind (N) = N_Subprogram_Body then
+                     if Nkind (Entity) = N_Subprogram_Body then
                         Entity := Specification (Entity);
                      end if;
 
@@ -1910,7 +1921,7 @@ package body Sem is
 
       --  Skip the rest if we're not supposed to print the withs
 
-      if False and then not Withs then -- ???
+      if not Withs then
          return;
       end if;
 

gcc/ada/sem_ch12.adb

@@ -4392,7 +4392,7 @@ package body Sem_Ch12 is
       --  If the instance is not the main unit, its context, categorization,
       --  and elaboration entity are not relevant to the compilation.
 
-      if Parent (N) /= Cunit (Main_Unit) then
+      if Body_Cunit /= Cunit (Main_Unit) then
          Make_Instance_Unit (Body_Cunit, In_Main => False);
          return;
       end if;