[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 dea19c8..8ccc29b 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 9c23106..91b84a1 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 ce6d88b..fc8f74c 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 9528841..7dec902 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 846f3a3..64b9092 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;