From b913199ea39e5027a5f4176f245fe7fef1951dcd Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 12 Dec 2011 13:06:59 +0100 Subject: [PATCH] [multiple changes] 2011-12-12 Ed Schonberg * 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 * sem.adb, sem.ads: Add debugging routines. 2011-12-12 Tristan Gingold * gnatls.adb: (gnatls): Also add the objects dir in search list. From-SVN: r182235 --- gcc/ada/ChangeLog | 17 +++++++++++++++++ gcc/ada/gnatls.adb | 8 ++++++++ gcc/ada/sem.adb | 20 +++++++++++++++++++- gcc/ada/sem.ads | 10 ++++++++++ gcc/ada/sem_ch6.adb | 15 ++++++++++++--- 5 files changed, 66 insertions(+), 4 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dea19c8888b..8ccc29bbbe7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2011-12-12 Ed Schonberg + + * 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 + + * sem.adb, sem.ads: Add debugging routines. + +2011-12-12 Tristan Gingold + + * gnatls.adb: (gnatls): Also add the objects dir in search list. + 2011-12-12 Robert Dewar * exp_atag.adb, exp_atag.ads, exp_util.adb, exp_attr.adb, diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 9c231068113..91b84a17300 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -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; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index ce6d88b8fb1..fc8f74cf811 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -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 diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index 9528841e1c8..7dec90243a9 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -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; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 846f3a30066..64b90926329 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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;