[multiple changes]

2010-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sinfo.ads, sinfo,adb (Withed_Body): New attribute of a with_clause.
	Indicates that there is an instantiation in the current unit that
	loaded the body of the unit denoted by the with_clause.
	* sem_ch12.adb (Mark_Context): When instanting a generic body, check
	whether a with_clause in the current context denotes the unit that
	holds the generic declaration, and mark the with_clause accordingly.
	(Instantiate_Package_Body): call Mark_Context.
	* sem.adb (Process_Bodies_In_Context): Use Withed_Body to determine
	whether a given body should be traversed before the spec of the main
	unit.

2010-06-14  Ed Falis  <falis@adacore.com>

	* sysdep.c: Fix 653 build against vThreads headers

From-SVN: r160725

gcc/ada/ChangeLog

+2010-06-14  Ed Schonberg  <schonberg@adacore.com>
+
+	* sinfo.ads, sinfo.adb (Withed_Body): New attribute of a with_clause.
+	Indicates that there is an instantiation in the current unit that
+	loaded the body of the unit denoted by the with_clause.
+	* sem_ch12.adb (Mark_Context): When instanting a generic body, check
+	whether a with_clause in the current context denotes the unit that
+	holds the generic declaration, and mark the with_clause accordingly.
+	(Instantiate_Package_Body): call Mark_Context.
+	* sem.adb (Process_Bodies_In_Context): Use Withed_Body to determine
+	whether a given body should be traversed before the spec of the main
+	unit.
+
+2010-06-14  Ed Falis  <falis@adacore.com>
+
+	* sysdep.c: Fix 653 build against vThreads headers
+
 2010-06-14  Robert Dewar  <dewar@adacore.com>
 
 	* sinfo.ads: Minor reformatting.

gcc/ada/sem.adb

@@ -1803,9 +1803,15 @@ package body Sem is
                Spec := Library_Unit (Clause);
                Body_CU := Library_Unit (Spec);
 
+               --  If we are processing the spec of the main unit, load bodies
+               --  only if the with_clause indicates that it forced the loading
+               --  of the body for a generic instantiation.
+
                if Present (Body_CU)
                  and then Body_CU /= Cunit (Main_Unit)
                  and then Nkind (Unit (Body_CU)) /= N_Subprogram_Body
+                 and then (Nkind (Unit (Comp)) /= N_Package_Declaration
+                    or else Present (Withed_Body (Clause)))
                then
                   Body_U := Get_Cunit_Unit_Number (Body_CU);
 

gcc/ada/sem_ch12.adb

@@ -475,6 +475,12 @@ package body Sem_Ch12 is
    --  of generic formals of a generic package declared with a box or with
    --  partial parametrization.
 
+   procedure Mark_Context (Inst_Decl : Node_Id; Gen_Decl : Node_Id);
+   --  If the generic unit comes from a different unit, indicate that the
+   --  unit that contains the instance depends on the body that contains
+   --  the generic body. Used to determine a more precise dependency graph
+   --  for use by CodePeer.
+
    procedure Set_Instance_Env
      (Gen_Unit : Entity_Id;
       Act_Unit : Entity_Id);
@@ -8590,6 +8596,7 @@ package body Sem_Ch12 is
            (Inst_Node, Specification (Gen_Decl), Body_Optional);
          Gen_Body_Id := Corresponding_Body (Gen_Decl);
       end if;
+      Mark_Context (Act_Decl, Gen_Decl);
 
       --  Establish global variable for sloc adjustment and for error recovery
 
@@ -10382,6 +10389,28 @@ package body Sem_Ch12 is
       end if;
    end Is_Generic_Formal;
 
+   ------------------
+   -- Mark_Context --
+   ------------------
+
+   procedure Mark_Context (Inst_Decl : Node_Id; Gen_Decl : Node_Id) is
+      Inst_CU : constant Unit_Number_Type := Get_Source_Unit (Inst_Decl);
+      Gen_CU  : constant Unit_Number_Type := Get_Source_Unit (Gen_Decl);
+      Clause  : Node_Id;
+
+   begin
+      Clause := First (Context_Items (Cunit (Inst_CU)));
+      while Present (Clause) loop
+         if Nkind (Clause) = N_With_Clause
+           and then  Library_Unit (Clause) = Cunit (Gen_CU)
+         then
+            Set_Withed_Body (Clause, Cunit (Gen_CU));
+         end if;
+
+         Next (Clause);
+      end loop;
+   end Mark_Context;
+
    ---------------------
    -- Is_In_Main_Unit --
    ---------------------

gcc/ada/sinfo.adb

@@ -2931,6 +2931,14 @@ package body Sinfo is
       return Flag13 (N);
    end Was_Originally_Stub;
 
+   function Withed_Body
+      (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_With_Clause);
+      return Node1 (N);
+   end Withed_Body;
+
    function Zero_Cost_Handling
       (N : Node_Id) return Boolean is
    begin
@@ -5809,6 +5817,14 @@ package body Sinfo is
       Set_Flag13 (N, Val);
    end Set_Was_Originally_Stub;
 
+   procedure Set_Withed_Body
+     (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_With_Clause);
+      Set_Node1 (N, Val);
+   end Set_Withed_Body;
+
    procedure Set_Zero_Cost_Handling
       (N : Node_Id; Val : Boolean := True) is
    begin

gcc/ada/sinfo.ads

@@ -1723,6 +1723,12 @@ package Sinfo is
    --    Original_Node here because of the case of nested instantiations where
    --    the substituted node can be copied.
 
+   --  Withed_Body (Node1-Sem)
+   --    Present in N_With_Clause nodes. Set if the unit in whose context
+   --    the with_clause appears instantiates a generic contained in the
+   --    library unit of the with_clause and as a result loads its body.
+   --    Used for a more precise unit traversal for CodePeer.
+
    --  Zero_Cost_Handling (Flag5-Sem)
    --    This flag is set in all handled sequence of statement and exception
    --    handler nodes if exceptions are to be handled using the zero-cost
@@ -5530,6 +5536,7 @@ package Sinfo is
 
       --  N_With_Clause
       --  Sloc points to first token of library unit name
+      --  Withed_Body (Node1-Sem)
       --  Name (Node2)
       --  Next_Implicit_With (Node3-Sem)
       --  Library_Unit (Node4-Sem)
@@ -8522,6 +8529,9 @@ package Sinfo is
    function Was_Originally_Stub
      (N : Node_Id) return Boolean;    -- Flag13
 
+   function Withed_Body
+     (N : Node_Id) return Node_Id;    -- Node1
+
    function Zero_Cost_Handling
      (N : Node_Id) return Boolean;    -- Flag5
 
@@ -9440,6 +9450,9 @@ package Sinfo is
    procedure Set_Was_Originally_Stub
      (N : Node_Id; Val : Boolean := True);    -- Flag13
 
+   procedure Set_Withed_Body
+     (N : Node_Id; Val : Node_Id);            -- Node1
+
    procedure Set_Zero_Cost_Handling
      (N : Node_Id; Val : Boolean := True);    -- Flag5
 
@@ -11441,6 +11454,7 @@ package Sinfo is
    pragma Inline (Variants);
    pragma Inline (Visible_Declarations);
    pragma Inline (Was_Originally_Stub);
+   pragma Inline (Withed_Body);
    pragma Inline (Zero_Cost_Handling);
 
    pragma Inline (Set_ABE_Is_Certain);
@@ -11743,6 +11757,7 @@ package Sinfo is
    pragma Inline (Set_Variants);
    pragma Inline (Set_Visible_Declarations);
    pragma Inline (Set_Was_Originally_Stub);
+   pragma Inline (Set_Withed_Body);
    pragma Inline (Set_Zero_Cost_Handling);
 
    N_Simple_Return_Statement : constant Node_Kind := N_Return_Statement;

gcc/ada/sysdep.c

@@ -34,7 +34,7 @@
 
 #ifdef __vxworks
 #include "ioLib.h"
-#if ! defined (__VXWORKSMILS__)
+#if ! defined (VTHREADS)
 #include "dosFsLib.h"
 #endif
 #if ! defined (__RTP__) && (! defined (VTHREADS) || defined (__VXWORKSMILS__))
@@ -987,7 +987,7 @@ __gnat_is_file_not_found_error (int errno_val) {
       /* In the case of VxWorks, we also have to take into account various
        * filesystem-specific variants of this error.
        */
-#if ! defined (__VXWORKSMILS__)
+#if ! defined (VTHREADS)
       case S_dosFsLib_FILE_NOT_FOUND:
 #endif
 #if ! defined (__RTP__) && (! defined (VTHREADS) || defined (__VXWORKSMILS__))