+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
-- --
-- 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- --
-----------------
procedure Delete_Tree (Directory : String) is
- Current_Dir : constant String := Current_Directory;
Search : Search_Type;
Dir_Ent : Directory_Entry_Type;
begin
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
-- 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;
-- 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;
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,
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);
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;