[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
This commit is contained in:
Arnaud Charlet 2016-05-02 11:30:59 +02:00
parent a25ad01cfb
commit 07eb872e34
4 changed files with 58 additions and 24 deletions

View 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

View 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

View 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;

View 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;