Commit 5d791dfb by Arnaud Charlet

[multiple changes]

2010-06-23  Robert Dewar  <dewar@adacore.com>

	* g-pehage.adb, exp_ch13.adb: Minor reformatting.

2010-06-23  Thomas Quinot  <quinot@adacore.com>

	* a-tags.ads: Fix description of TSD structure.

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

	* sem_ch12.adb (Mark_Context): When indicating that the body of a
	generic unit is needed prior to the unit containing an instantiation,
	search recursively the context of the generic to add other generic
	bodies that may be instantiated indirectly through the current instance.

From-SVN: r161251
parent cd5a9750
2010-06-23 Robert Dewar <dewar@adacore.com> 2010-06-23 Robert Dewar <dewar@adacore.com>
* g-pehage.adb, exp_ch13.adb: Minor reformatting.
2010-06-23 Thomas Quinot <quinot@adacore.com>
* a-tags.ads: Fix description of TSD structure.
2010-06-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Mark_Context): When indicating that the body of a
generic unit is needed prior to the unit containing an instantiation,
search recursively the context of the generic to add other generic
bodies that may be instantiated indirectly through the current instance.
2010-06-23 Robert Dewar <dewar@adacore.com>
* freeze.adb: Minor reformatting. * freeze.adb: Minor reformatting.
2010-06-23 Bob Duff <duff@adacore.com> 2010-06-23 Bob Duff <duff@adacore.com>
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -101,7 +101,7 @@ private ...@@ -101,7 +101,7 @@ private
-- +-------------------+ -- +-------------------+
-- | hash table link | -- | hash table link |
-- +-------------------+ -- +-------------------+
-- | remotely callable | -- | transportable |
-- +-------------------+ -- +-------------------+
-- | rec ctrler offset | -- | rec ctrler offset |
-- +-------------------+ -- +-------------------+
......
...@@ -358,7 +358,6 @@ package body Exp_Ch13 is ...@@ -358,7 +358,6 @@ package body Exp_Ch13 is
then then
declare declare
Save_Force : constant Boolean := Force_Validity_Checks; Save_Force : constant Boolean := Force_Validity_Checks;
begin begin
Force_Validity_Checks := True; Force_Validity_Checks := True;
Analyze (Decl); Analyze (Decl);
......
...@@ -2519,6 +2519,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -2519,6 +2519,7 @@ package body GNAT.Perfect_Hash_Generators is
return Str (Str'First .. J); return Str (Str'First .. J);
end if; end if;
end loop; end loop;
return Str; return Str;
end Trim_Trailing_Nuls; end Trim_Trailing_Nuls;
......
...@@ -10394,16 +10394,78 @@ package body Sem_Ch12 is ...@@ -10394,16 +10394,78 @@ package body Sem_Ch12 is
------------------ ------------------
procedure Mark_Context (Inst_Decl : Node_Id; Gen_Decl : Node_Id) is procedure Mark_Context (Inst_Decl : Node_Id; Gen_Decl : Node_Id) is
Loc : constant Source_Ptr := Sloc (Inst_Decl);
Inst_CU : constant Unit_Number_Type := Get_Code_Unit (Inst_Decl); Inst_CU : constant Unit_Number_Type := Get_Code_Unit (Inst_Decl);
-- Note that we use Get_Code_Unit to determine the position of the
-- instantiation, because it may itself appear within another instance
-- and we need to mark the context of the enclosing unit, not that of
-- the unit that contains the generic.
Gen_CU : constant Unit_Number_Type := Get_Source_Unit (Gen_Decl); Gen_CU : constant Unit_Number_Type := Get_Source_Unit (Gen_Decl);
Inst : Entity_Id; Inst : Entity_Id;
Clause : Node_Id; Clause : Node_Id;
Scop : Entity_Id;
procedure Add_Implicit_With (CU : Unit_Number_Type);
-- If a generic is instantiated in the direct or indirect context of
-- the current unit, but there is no with_clause for it in the current
-- context, add a with_clause for it to indicate that the body of the
-- generic should be examined before the current unit.
procedure Add_Implicit_With (CU : Unit_Number_Type) is
Withn : constant Node_Id :=
Make_With_Clause (Loc,
Name => New_Occurrence_Of (Cunit_Entity (CU), Loc));
begin begin
-- Note that we use Get_Code_Unit to determine the position of the Set_Implicit_With (Withn);
-- instantiation, because it may itself appear within another instance Set_Library_Unit (Withn, Cunit (CU));
-- and we need to mark the context of the enclosing unit, not that of Set_Withed_Body (Withn, Cunit (CU));
-- the unit that contains the corresponding generic. Append (Withn, Context_Items (Cunit (Inst_CU)));
end Add_Implicit_With;
begin
-- This is only relevant when compiling for CodePeer. In what follows,
-- C is the current unit containing the instance body, and G is the
-- generic unit in that instance.
if not CodePeer_Mode then
return;
end if;
-- If G is itself declared within an instance, indicate that the generic
-- body of that instance is also needed by C. This must be done
-- recursively.
Scop := Scope (Defining_Entity (Gen_Decl));
while Is_Generic_Instance (Scop)
and then Ekind (Scop) = E_Package
loop
Mark_Context
(Inst_Decl,
Unit_Declaration_Node (Generic_Parent (Parent (Scop))));
Scop := Scope (Scop);
end loop;
-- Add references to other generic units in the context of G, because
-- they may be instantiated within G, and their bodies needed by C.
Clause := First (Context_Items (Cunit (Gen_CU)));
while Present (Clause) loop
if Nkind (Clause) = N_With_Clause
and then
Nkind (Unit (Library_Unit (Clause)))
= N_Generic_Package_Declaration
then
Add_Implicit_With (Get_Source_Unit (Library_Unit (Clause)));
end if;
Next (Clause);
end loop;
-- Now indicate that the body of G is needed by C
Clause := First (Context_Items (Cunit (Inst_CU))); Clause := First (Context_Items (Cunit (Inst_CU)));
while Present (Clause) loop while Present (Clause) loop
...@@ -10417,8 +10479,8 @@ package body Sem_Ch12 is ...@@ -10417,8 +10479,8 @@ package body Sem_Ch12 is
Next (Clause); Next (Clause);
end loop; end loop;
-- If the with-clause for the generic unit was not found, it must -- If the with-clause for G is not in the context of C, it may appear in
-- appear in some ancestor of the current unit. -- some ancestor of C.
Inst := Cunit_Entity (Inst_CU); Inst := Cunit_Entity (Inst_CU);
while Is_Child_Unit (Inst) loop while Is_Child_Unit (Inst) loop
...@@ -10437,6 +10499,11 @@ package body Sem_Ch12 is ...@@ -10437,6 +10499,11 @@ package body Sem_Ch12 is
Next (Clause); Next (Clause);
end loop; end loop;
end loop; end loop;
-- If not found, G comes from an instance elsewhere in the context. Make
-- the dependence explicit in the context of C.
Add_Implicit_With (Gen_CU);
end Mark_Context; end Mark_Context;
--------------------- ---------------------
...@@ -10499,8 +10566,8 @@ package body Sem_Ch12 is ...@@ -10499,8 +10566,8 @@ package body Sem_Ch12 is
-- instantiations are available, we must analyze them, to ensure that -- instantiations are available, we must analyze them, to ensure that
-- the public symbols generated are the same when the unit is compiled -- the public symbols generated are the same when the unit is compiled
-- to generate code, and when it is compiled in the context of a unit -- to generate code, and when it is compiled in the context of a unit
-- that needs a particular nested instance. This process is applied -- that needs a particular nested instance. This process is applied to
-- to both package and subprogram instances. -- both package and subprogram instances.
-------------------------------- --------------------------------
-- Collect_Previous_Instances -- -- Collect_Previous_Instances --
...@@ -10650,9 +10717,8 @@ package body Sem_Ch12 is ...@@ -10650,9 +10717,8 @@ package body Sem_Ch12 is
-- enclosing body. Because the generic body we need may use -- enclosing body. Because the generic body we need may use
-- global entities declared in the enclosing package (including -- global entities declared in the enclosing package (including
-- aggregates) it is in general necessary to compile this body -- aggregates) it is in general necessary to compile this body
-- with expansion enabled. The exception is if we are within a -- with expansion enabled, except if we are within a generic
-- generic package, in which case the usual generic rule -- package, in which case the usual generic rule applies.
-- applies.
declare declare
Exp_Status : Boolean := True; Exp_Status : Boolean := True;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment