[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Mon, 2 May 2016 09:30:59 +0000 (11:30 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Mon, 2 May 2016 09:30:59 +0000 (11:30 +0200)
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

gcc/ada/ChangeLog
gcc/ada/a-direct.adb
gcc/ada/sem_aggr.adb
gcc/ada/sem_ch10.adb

index c4fa0ae19af307c187131ee7526ffd3a1ae83ff5..d05918c29b9c629bf146360c812edb49155cc023 100644 (file)
@@ -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
index 7c5c4f455579bbbea469ec187eacc03b04c3a5d1..500a31d409626b80491842d3e86f8d70b8d2ae1b 100644 (file)
@@ -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
index 876521b6d23cd3b04b21895dc8bf805996433bee..8b6504575ca244612de8816a439de5ce33241315 100644 (file)
@@ -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;
 
index 5ab4afb4be8ae5e9be14344edffc6b5889267abc..d4cd883c0d01b27cd2a08a6ef72afaa6d089d586 100644 (file)
@@ -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;