[multiple changes]

2016-05-02  Bob Duff  <duff@adacore.com>

	* sem_ch10.adb (Analyze_Compilation_Unit): Preserve
	treeishness. Previous version had Context_Items shared between
	the spec and body.

2016-05-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Resolve_Aggr_Expression): For both array and
	record cases, apply predicate check on component for expression
	only if expression has been analyzed already. For expressions
	that need to be duplicated when they cover multiple components,
	resolution and predicate checking take place later.

2016-05-02  Olivier Hainque  <hainque@adacore.com>

	* a-direct.adb (Delete_Tree): Use full names to designate subdirs
	and files therein, instead of local names after a change of
	current directory.

From-SVN: r235717

4 files changed, 58 insertions, 24 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c4fa0ae..d05918c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2016-05-02  Bob Duff  <duff@adacore.com>
+
+	* sem_ch10.adb (Analyze_Compilation_Unit): Preserve
+	treeishness. Previous version had Context_Items shared between
+	the spec and body.
+
+2016-05-02  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aggr.adb (Resolve_Aggr_Expression): For both array and
+	record cases, apply predicate check on component for expression
+	only if expression has been analyzed already. For expressions
+	that need to be duplicated when they cover multiple components,
+	resolution and predicate checking take place later.
+
+2016-05-02  Olivier Hainque  <hainque@adacore.com>
+
+	* a-direct.adb (Delete_Tree): Use full names to designate subdirs
+	and files therein, instead of local names after a change of
+	current directory.
+
 2016-05-02  Thomas Quinot  <quinot@adacore.com>
 
 	* freeze.adb (Check_Component_Storage_Order): Get full view of
diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb
index 7c5c4f4..500a31d 100644
--- a/gcc/ada/a-direct.adb
+++ b/gcc/ada/a-direct.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -597,7 +597,6 @@ package body Ada.Directories is
    -----------------
 
    procedure Delete_Tree (Directory : String) is
-      Current_Dir : constant String := Current_Directory;
       Search      : Search_Type;
       Dir_Ent     : Directory_Entry_Type;
    begin
@@ -611,28 +610,32 @@ package body Ada.Directories is
          raise Name_Error with '"' & Directory & """ not a directory";
 
       else
-         Set_Directory (Directory);
 
-         Start_Search (Search, Directory => ".", Pattern => "");
+         --  We used to change the current directory to Directory here,
+         --  allowing the use of a local Simple_Name for all references. This
+         --  turned out unfriendly to multitasking programs, where tasks
+         --  running in parallel of this Delete_Tree could see their current
+         --  directory change unpredictably. We now resort to Full_Name
+         --  computations to reach files and subdirs instead.
+
+         Start_Search (Search, Directory => Directory, Pattern => "");
          while More_Entries (Search) loop
             Get_Next_Entry (Search, Dir_Ent);
 
             declare
-               File_Name : constant String := Simple_Name (Dir_Ent);
-
+               Sname : constant String := Simple_Name (Dir_Ent);
+               Fname : constant String := Full_Name (Dir_Ent);
             begin
-               if OS_Lib.Is_Directory (File_Name) then
-                  if File_Name /= "." and then File_Name /= ".." then
-                     Delete_Tree (File_Name);
+               if OS_Lib.Is_Directory (Fname) then
+                  if Sname /= "." and then Sname /= ".." then
+                     Delete_Tree (Fname);
                   end if;
-
                else
-                  Delete_File (File_Name);
+                  Delete_File (Fname);
                end if;
             end;
          end loop;
 
-         Set_Directory (Current_Dir);
          End_Search (Search);
 
          declare
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 876521b..8b65045 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -1610,9 +1610,12 @@ package body Sem_Aggr is
          --  If an aggregate component has a type with predicates, an explicit
          --  predicate check must be applied, as for an assignment statement,
          --  because the aggegate might not be expanded into individual
-         --  component assignments.
+         --  component assignments. If the expression covers several components
+         --  the analysis and the predicate check take place later.
 
-         if Present (Predicate_Function (Component_Typ)) then
+         if Present (Predicate_Function (Component_Typ))
+           and then Analyzed (Expr)
+         then
             Apply_Predicate_Check (Expr, Component_Typ);
          end if;
 
@@ -3565,7 +3568,9 @@ package body Sem_Aggr is
          --  because the aggegate might not be expanded into individual
          --  component assignments.
 
-         if Present (Predicate_Function (Expr_Type)) then
+         if Present (Predicate_Function (Expr_Type))
+           and then Analyzed (Expr)
+         then
             Apply_Predicate_Check (Expr, Expr_Type);
          end if;
 
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 5ab4afb..d4cd883 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -783,15 +783,15 @@ package body Sem_Ch10 is
                   begin
                      Set_Comes_From_Source_Default (False);
 
-                     --  Checks for redundant USE TYPE clauses have a special
-                     --  exception for the synthetic spec we create here. This
-                     --  special case relies on the two compilation units
-                     --  sharing the same context clause.
-
-                     --  Note: We used to do a shallow copy (New_Copy_List),
-                     --  which defeated those checks and also created malformed
-                     --  trees (subtype mark shared by two distinct
-                     --  N_Use_Type_Clause nodes) which crashed the compiler.
+                     --  Note: We copy the Context_Items from the explicit body
+                     --  to the implicit spec, setting the former to Empty_List
+                     --  to preserve the treeish nature of the tree, during
+                     --  analysis of the spec. Then we put it back the way it
+                     --  was -- copy the Context_Items from the spec to the
+                     --  body, and set the spec Context_Items to Empty_List.
+                     --  It is necessary to preserve the treeish nature,
+                     --  because otherwise we will call End_Use_* twice on the
+                     --  same thing.
 
                      Lib_Unit :=
                        Make_Compilation_Unit (Loc,
@@ -804,6 +804,7 @@ package body Sem_Ch10 is
                          Aux_Decls_Node =>
                            Make_Compilation_Unit_Aux (Loc));
 
+                     Set_Context_Items (N, Empty_List);
                      Set_Library_Unit (N, Lib_Unit);
                      Set_Parent_Spec (Unit (Lib_Unit), Cunit (Unum));
                      Make_Child_Decl_Unit (N);
@@ -816,6 +817,11 @@ package body Sem_Ch10 is
                      Set_Is_Child_Unit (Defining_Entity (Unit_Node));
                      Set_Debug_Info_Needed (Defining_Entity (Unit (Lib_Unit)));
                      Set_Comes_From_Source_Default (SCS);
+
+                     --  Restore Context_Items to the body
+
+                     Set_Context_Items (N, Context_Items (Lib_Unit));
+                     Set_Context_Items (Lib_Unit, Empty_List);
                   end;
                end if;
             end if;