Commit b913199e by Arnaud Charlet

[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
parent f0f3286a
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> 2011-12-12 Robert Dewar <dewar@adacore.com>
* exp_atag.adb, exp_atag.ads, exp_util.adb, exp_attr.adb, * exp_atag.adb, exp_atag.ads, exp_util.adb, exp_attr.adb,
......
...@@ -1228,6 +1228,14 @@ procedure Gnatls is ...@@ -1228,6 +1228,14 @@ procedure Gnatls is
if Src_Path /= null then if Src_Path /= null then
Add_Search_Dirs (Src_Path, Include); 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; return;
end if; end if;
end if; end if;
......
...@@ -1555,6 +1555,24 @@ package body Sem is ...@@ -1555,6 +1555,24 @@ package body Sem is
end if; end if;
end Semantics; 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 -- -- Walk_Library_Items --
------------------------ ------------------------
...@@ -1602,7 +1620,7 @@ package body Sem is ...@@ -1602,7 +1620,7 @@ package body Sem is
-- an instance spec, do the body last. -- an instance spec, do the body last.
procedure Do_Withed_Unit (Withed_Unit : Node_Id); 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); procedure Process_Bodies_In_Context (Comp : Node_Id);
-- The main unit and its spec may depend on bodies that contain generics -- The main unit and its spec may depend on bodies that contain generics
......
...@@ -660,4 +660,14 @@ package Sem is ...@@ -660,4 +660,14 @@ package Sem is
-- Item is never an instantiation. Instead, the instance declaration is -- Item is never an instantiation. Instead, the instance declaration is
-- passed, and (if the instantiation is the main unit), the instance body. -- 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; end Sem;
...@@ -281,6 +281,7 @@ package body Sem_Ch6 is ...@@ -281,6 +281,7 @@ package body Sem_Ch6 is
New_Body : Node_Id; New_Body : Node_Id;
New_Decl : Node_Id; New_Decl : Node_Id;
New_Spec : Node_Id; New_Spec : Node_Id;
Ret : Node_Id;
begin begin
-- This is one of the occasions on which we transform the tree during -- This is one of the occasions on which we transform the tree during
...@@ -302,15 +303,15 @@ package body Sem_Ch6 is ...@@ -302,15 +303,15 @@ package body Sem_Ch6 is
Prev := Find_Corresponding_Spec (N); Prev := Find_Corresponding_Spec (N);
end if; end if;
Ret := Make_Simple_Return_Statement (LocX, Expression (N));
New_Body := New_Body :=
Make_Subprogram_Body (Loc, Make_Subprogram_Body (Loc,
Specification => New_Spec, Specification => New_Spec,
Declarations => Empty_List, Declarations => Empty_List,
Handled_Statement_Sequence => Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (LocX, Make_Handled_Sequence_Of_Statements (LocX,
Statements => New_List ( Statements => New_List (Ret)));
Make_Simple_Return_Statement (LocX,
Expression => Expression (N)))));
if Present (Prev) and then Ekind (Prev) = E_Generic_Function then if Present (Prev) and then Ekind (Prev) = E_Generic_Function then
...@@ -362,10 +363,13 @@ package body Sem_Ch6 is ...@@ -362,10 +363,13 @@ package body Sem_Ch6 is
-- To prevent premature freeze action, insert the new body at the end -- To prevent premature freeze action, insert the new body at the end
-- of the current declarations, or at the end of the package spec. -- 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 declare
Decls : List_Id := List_Containing (N); Decls : List_Id := List_Containing (N);
Par : constant Node_Id := Parent (Decls); Par : constant Node_Id := Parent (Decls);
Id : constant Entity_Id := Defining_Entity (New_Decl);
begin begin
if Nkind (Par) = N_Package_Specification if Nkind (Par) = N_Package_Specification
...@@ -377,6 +381,11 @@ package body Sem_Ch6 is ...@@ -377,6 +381,11 @@ package body Sem_Ch6 is
end if; end if;
Insert_After (Last (Decls), New_Body); Insert_After (Last (Decls), New_Body);
Push_Scope (Id);
Install_Formals (Id);
Preanalyze_Spec_Expression (Expression (Ret), Etype (Id));
End_Scope;
end; end;
end if; end if;
......
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