[multiple changes]

2011-12-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Expression_Function): If the function
	is not a completion, pre-analyze the expression now to prevent
	spurious visibility on later entities. The body is inserted at
	the end of the current declaration list or package to prevent
	early freezing, but the visibility is established at the point
	of definition.

2011-12-12  Bob Duff  <duff@adacore.com>

	* sem.adb, sem.ads: Add debugging routines.

2011-12-12  Tristan Gingold  <gingold@adacore.com>

	* gnatls.adb: (gnatls): Also add the objects dir in search list.

From-SVN: r182235
This commit is contained in:
Arnaud Charlet 2011-12-12 13:06:59 +01:00
parent f0f3286a5a
commit b913199ea3
5 changed files with 66 additions and 4 deletions

View File

@ -1,3 +1,20 @@
2011-12-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Expression_Function): If the function
is not a completion, pre-analyze the expression now to prevent
spurious visibility on later entities. The body is inserted at
the end of the current declaration list or package to prevent
early freezing, but the visibility is established at the point
of definition.
2011-12-12 Bob Duff <duff@adacore.com>
* sem.adb, sem.ads: Add debugging routines.
2011-12-12 Tristan Gingold <gingold@adacore.com>
* gnatls.adb: (gnatls): Also add the objects dir in search list.
2011-12-12 Robert Dewar <dewar@adacore.com>
* exp_atag.adb, exp_atag.ads, exp_util.adb, exp_attr.adb,

View File

@ -1228,6 +1228,14 @@ procedure Gnatls is
if Src_Path /= null then
Add_Search_Dirs (Src_Path, Include);
-- Add the lib subdirectory if it exists
Lib_Path := Get_RTS_Search_Dir (Name, Objects);
if Lib_Path /= null then
Add_Search_Dirs (Lib_Path, Objects);
end if;
return;
end if;
end if;

View File

@ -1555,6 +1555,24 @@ package body Sem is
end if;
end Semantics;
--------
-- ss --
--------
function ss (Index : Int) return Scope_Stack_Entry is
begin
return Scope_Stack.Table (Index);
end ss;
---------
-- sst --
---------
function sst return Scope_Stack_Entry is
begin
return ss (Scope_Stack.Last);
end sst;
------------------------
-- Walk_Library_Items --
------------------------
@ -1602,7 +1620,7 @@ package body Sem is
-- an instance spec, do the body last.
procedure Do_Withed_Unit (Withed_Unit : Node_Id);
-- Apply Do_Unit_And_Dependents to a unit in a context clause.
-- Apply Do_Unit_And_Dependents to a unit in a context clause
procedure Process_Bodies_In_Context (Comp : Node_Id);
-- The main unit and its spec may depend on bodies that contain generics

View File

@ -660,4 +660,14 @@ package Sem is
-- Item is never an instantiation. Instead, the instance declaration is
-- passed, and (if the instantiation is the main unit), the instance body.
-- Debugging:
function ss (Index : Int) return Scope_Stack_Entry;
pragma Export (Ada, ss);
-- "ss" = "scope stack"; returns the Index'th entry in the Scope_Stack
function sst return Scope_Stack_Entry;
pragma Export (Ada, sst);
-- "sst" = "scope stack top"; same as ss(Scope_Stack.Last)
end Sem;

View File

@ -281,6 +281,7 @@ package body Sem_Ch6 is
New_Body : Node_Id;
New_Decl : Node_Id;
New_Spec : Node_Id;
Ret : Node_Id;
begin
-- This is one of the occasions on which we transform the tree during
@ -302,15 +303,15 @@ package body Sem_Ch6 is
Prev := Find_Corresponding_Spec (N);
end if;
Ret := Make_Simple_Return_Statement (LocX, Expression (N));
New_Body :=
Make_Subprogram_Body (Loc,
Specification => New_Spec,
Declarations => Empty_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (LocX,
Statements => New_List (
Make_Simple_Return_Statement (LocX,
Expression => Expression (N)))));
Statements => New_List (Ret)));
if Present (Prev) and then Ekind (Prev) = E_Generic_Function then
@ -362,10 +363,13 @@ package body Sem_Ch6 is
-- To prevent premature freeze action, insert the new body at the end
-- of the current declarations, or at the end of the package spec.
-- However, resolve usage names now, to prevent spurious visibility
-- on later entities.
declare
Decls : List_Id := List_Containing (N);
Par : constant Node_Id := Parent (Decls);
Id : constant Entity_Id := Defining_Entity (New_Decl);
begin
if Nkind (Par) = N_Package_Specification
@ -377,6 +381,11 @@ package body Sem_Ch6 is
end if;
Insert_After (Last (Decls), New_Body);
Push_Scope (Id);
Install_Formals (Id);
Preanalyze_Spec_Expression (Expression (Ret), Etype (Id));
End_Scope;
end;
end if;