diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 20 | ||||
| -rw-r--r-- | gcc/ada/a-direct.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 24 |
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; |