+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.
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);
-- 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);
(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
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 --
---------------------
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
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
-- 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
-- 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)
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
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
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);
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;
#ifdef __vxworks
#include "ioLib.h"
-#if ! defined (__VXWORKSMILS__)
+#if ! defined (VTHREADS)
#include "dosFsLib.h"
#endif
#if ! defined (__RTP__) && (! defined (VTHREADS) || defined (__VXWORKSMILS__))
/* 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__))
projects / platform / upstream / gcc.git / commitdiff