[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:
parent
a25ad01cfb
commit
07eb872e34
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue