[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index dea19c8888b7d5571e27f5b74102291cd1130255..8ccc29bbbe705f3a43eb1c0a5c7f8beb1aa4d744 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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,

diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb
index 9c23106811340f23c478c6d020fcd225c9921217..91b84a173009c57b9b49098f8afb50c41c9881b5 100644 (file)
--- 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 ce6d88b8fb1db443aa85a809e574c1ac4cf231d9..fc8f74cf811448d61b29e1255f53a5a705b11c43 100644 (file)
--- 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 9528841e1c80252e574eb79770faaa15f8f5d699..7dec90243a9089e8bd5b2e50d8535f609c435109 100644 (file)
--- 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 846f3a300661ca4b1150a24d2a00a2edb260ffc1..64b909263292dfbfc323b61302facf9f7f37dc90 100644 (file)
--- 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;