From: Arnaud Charlet Date: Wed, 31 Aug 2011 09:37:54 +0000 (+0200) Subject: [multiple changes] X-Git-Tag: upstream/12.2.0~81653 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=702d2020441d58a06cd7b161483d9c099e56c72b;p=platform%2Fupstream%2Fgcc.git [multiple changes] 2011-08-31 Jose Ruiz * s-taprop-vxworks.adb, s-taprop-mingw.adb, s-taprop-linux.adb, s-taprop-solaris.adb (Create_Task): Not_A_Specific_CPU can be assigned to any dispatching domain. 2011-08-31 Thomas Quinot * exp_ch4.adb: Minor reformatting. 2011-08-31 Bob Duff * sem_ch6.adb (Get_Generic_Parent_Type): Don't query Subtype_Indication on nodes for which it is not defined. (Is_Non_Overriding_Operation): Exit the loop when we find a generic parent type. 2011-08-31 Bob Duff * sem_ch3.adb (Process_Full_View): Disable legality check if In_Instance, to avoid spurious errors. * sem_ch12.adb (Validate_Derived_Type_Instance): Disable legality check if In_Instance, to avoid spurious errors. 2011-08-31 Pascal Obry * a-direct.adb: Use Dir_Seps everywhere to properly handle all directory speparators. (Compose): Use Dir_Seps to handle both forms. (Create_Path): Use Dir_Seps instead of explicit check, no semantic changes. (Extension): Use Dir_Seps to handle both forms. 2011-08-31 Pascal Obry * prj-conf.adb: Minor reformatting. From-SVN: r178372 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 58e43de..1fb2088 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,42 @@ 2011-08-31 Jose Ruiz + * s-taprop-vxworks.adb, s-taprop-mingw.adb, s-taprop-linux.adb, + s-taprop-solaris.adb (Create_Task): Not_A_Specific_CPU can be assigned + to any dispatching domain. + +2011-08-31 Thomas Quinot + + * exp_ch4.adb: Minor reformatting. + +2011-08-31 Bob Duff + + * sem_ch6.adb (Get_Generic_Parent_Type): Don't query Subtype_Indication + on nodes for which it is not defined. + (Is_Non_Overriding_Operation): Exit the loop when we find a generic + parent type. + +2011-08-31 Bob Duff + + * sem_ch3.adb (Process_Full_View): Disable legality check if + In_Instance, to avoid spurious errors. + * sem_ch12.adb (Validate_Derived_Type_Instance): Disable legality check + if In_Instance, to avoid spurious errors. + +2011-08-31 Pascal Obry + + * a-direct.adb: Use Dir_Seps everywhere to properly handle all + directory speparators. + (Compose): Use Dir_Seps to handle both forms. + (Create_Path): Use Dir_Seps instead of explicit check, no semantic + changes. + (Extension): Use Dir_Seps to handle both forms. + +2011-08-31 Pascal Obry + + * prj-conf.adb: Minor reformatting. + +2011-08-31 Jose Ruiz + * aspects.ads (Aspect_Id, Aspect_Argument, Aspect_Names): Add the dispatching domain aspect. * aspects.adb (Canonical_Aspect): Add entry for the dispatching domain diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb index 6bb499e..b9dee7f 100644 --- a/gcc/ada/a-direct.adb +++ b/gcc/ada/a-direct.adb @@ -32,7 +32,7 @@ with Ada.Calendar; use Ada.Calendar; with Ada.Calendar.Formatting; use Ada.Calendar.Formatting; with Ada.Directories.Validity; use Ada.Directories.Validity; -with Ada.Strings.Maps; +with Ada.Strings.Maps; use Ada; use Ada.Strings.Maps; with Ada.Strings.Fixed; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Unchecked_Conversion; @@ -61,8 +61,7 @@ package body Ada.Directories is pragma Import (C, Dir_Separator, "__gnat_dir_separator"); -- Running system default directory separator - Dir_Seps : constant Ada.Strings.Maps.Character_Set := - Ada.Strings.Maps.To_Set ("/\"); + Dir_Seps : constant Character_Set := Strings.Maps.To_Set ("/\"); -- UNIX and DOS style directory separators Max_Path : Integer; @@ -175,7 +174,7 @@ package body Ada.Directories is -- Add a directory separator if needed - if Last /= 0 and then Result (Last) /= Dir_Separator then + if Last /= 0 and then not Is_In (Result (Last), Dir_Seps) then Last := Last + 1; Result (Last) := Dir_Separator; end if; @@ -457,17 +456,13 @@ package body Ada.Directories is -- Look for the end of an intermediate directory - if New_Dir (J) /= Dir_Separator and then - New_Dir (J) /= '/' - then + if not Is_In (New_Dir (J), Dir_Seps) then Last := J; -- We have found a new intermediate directory each time we find -- a first directory separator. - elsif New_Dir (J - 1) /= Dir_Separator and then - New_Dir (J - 1) /= '/' - then + elsif not Is_In (New_Dir (J - 1), Dir_Seps) then -- No need to create the directory if it already exists @@ -664,7 +659,7 @@ package body Ada.Directories is -- If a directory separator is found before a dot, there is no -- extension. - if Name (Pos) = Dir_Separator then + if Is_In (Name (Pos), Dir_Seps) then return Empty_String; elsif Name (Pos) = '.' then diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index e7d1791..3811e19 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7920,7 +7920,12 @@ package body Exp_Ch4 is -- Insert explicit dereference if required if Is_Access_Type (Ptyp) then - Set_Etype (P, Ptyp); -- in case it's private + + -- First set prefix type to proper access type, in case it currently + -- has a private (non-access) view of this type. + + Set_Etype (P, Ptyp); + Insert_Explicit_Dereference (P); Analyze_And_Resolve (P, Designated_Type (Ptyp)); diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 76a028e..ae1d0c6 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -162,12 +162,12 @@ package body Prj.Conf is -- configuration list. declare - Conf_List : String_List_Id := Conf_Attr.Value.Values; - Conf_Elem : String_Element; User_List : constant String_List_Id := User_Attr.Value.Values; - New_List : String_List_Id; - New_Elem : String_Element; + Conf_List : String_List_Id := Conf_Attr.Value.Values; + Conf_Elem : String_Element; + New_List : String_List_Id; + New_Elem : String_Element; begin -- Create new list @@ -525,7 +525,7 @@ package body Prj.Conf is if Proj.Project.Qualifier = Aggregate then declare List : Aggregated_Project_List := - Proj.Project.Aggregated_Projects; + Proj.Project.Aggregated_Projects; begin while List /= null loop Debug_Output @@ -549,12 +549,13 @@ package body Prj.Conf is ------------------ function Check_Target - (Config_File : Project_Id; + (Config_File : Project_Id; Autoconf_Specified : Boolean; - Project_Tree : Prj.Project_Tree_Ref; - Target : String := "") return Boolean + Project_Tree : Prj.Project_Tree_Ref; + Target : String := "") return Boolean is - Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared; + Shared : constant Shared_Project_Tree_Data_Access := + Project_Tree.Shared; Variable : constant Variable_Value := Value_Of (Name_Target, Config_File.Decl.Attributes, Shared); @@ -712,6 +713,7 @@ package body Prj.Conf is ------------------------- function Get_Config_Switches return Argument_List_Access is + package Language_Htable is new GNAT.HTable.Simple_HTable (Header_Num => Prj.Header_Num, Element => Name_Id, @@ -731,6 +733,10 @@ package body Prj.Conf is -- Add all --config switches for this project. This is also called -- for aggregate projects. + ------------------------------------- + -- Add_Config_Switches_For_Project -- + ------------------------------------- + procedure Add_Config_Switches_For_Project (Project : Project_Id; Tree : Project_Tree_Ref; @@ -828,9 +834,9 @@ package body Prj.Conf is begin For_Every_Imported_Project - (By => Project, - Tree => Project_Tree, - With_State => Dummy, + (By => Project, + Tree => Project_Tree, + With_State => Dummy, Include_Aggregated => True); Name := Language_Htable.Get_First; @@ -859,10 +865,10 @@ package body Prj.Conf is declare Config_Command : constant String := - "--config=" & Get_Name_String (Name); + "--config=" & Get_Name_String (Name); Runtime_Name : constant String := - Runtime_Name_For (Name); + Runtime_Name_For (Name); begin if Variable = Nil_Variable_Value @@ -876,7 +882,7 @@ package body Prj.Conf is declare Compiler_Command : constant String := - Get_Name_String (Variable.Value); + Get_Name_String (Variable.Value); begin if Is_Absolute_Path (Compiler_Command) then @@ -1245,8 +1251,8 @@ package body Prj.Conf is end if; if Config_File_Path = null then - if (not Allow_Automatic_Generation) and then - Config_File_Name /= "" + if (not Allow_Automatic_Generation) + and then Config_File_Name /= "" then Raise_Invalid_Config ("could not locate main configuration project " @@ -1386,18 +1392,18 @@ package body Prj.Conf is Prj.Initialize (Project_Tree); - Main_Project := No_Project; + Main_Project := No_Project; Automatically_Generated := False; Prj.Part.Parse - (In_Tree => Project_Node_Tree, - Project => User_Project_Node, - Project_File_Name => Project_File_Name, - Errout_Handling => Prj.Part.Finalize_If_Error, - Packages_To_Check => Packages_To_Check, - Current_Directory => Current_Directory, - Is_Config_File => False, - Env => Env); + (In_Tree => Project_Node_Tree, + Project => User_Project_Node, + Project_File_Name => Project_File_Name, + Errout_Handling => Prj.Part.Finalize_If_Error, + Packages_To_Check => Packages_To_Check, + Current_Directory => Current_Directory, + Is_Config_File => False, + Env => Env); if User_Project_Node = Empty_Node then User_Project_Node := Empty_Node; @@ -1442,9 +1448,10 @@ package body Prj.Conf is On_Load_Config : Config_File_Hook := null; Reset_Tree : Boolean := True) is - Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared; + Shared : constant Shared_Project_Tree_Data_Access := + Project_Tree.Shared; Main_Config_Project : Project_Id; - Success : Boolean; + Success : Boolean; begin Main_Project := No_Project; @@ -1468,10 +1475,10 @@ package body Prj.Conf is if not Is_Absolute_Path (Project_Tree.Source_Info_File_Name.all) then declare Obj_Dir : constant Variable_Value := - Value_Of - (Name_Object_Dir, - Main_Project.Decl.Attributes, - Shared); + Value_Of + (Name_Object_Dir, + Main_Project.Decl.Attributes, + Shared); begin if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then @@ -1523,16 +1530,16 @@ package body Prj.Conf is -- Finish processing the user's project Prj.Proc.Process_Project_Tree_Phase_2 - (In_Tree => Project_Tree, - Project => Main_Project, - Success => Success, - From_Project_Node => User_Project_Node, - From_Project_Node_Tree => Project_Node_Tree, - Env => Env); + (In_Tree => Project_Tree, + Project => Main_Project, + Success => Success, + From_Project_Node => User_Project_Node, + From_Project_Node_Tree => Project_Node_Tree, + Env => Env); if Success then - if Project_Tree.Source_Info_File_Name /= null and then - not Project_Tree.Source_Info_File_Exists + if Project_Tree.Source_Info_File_Name /= null + and then not Project_Tree.Source_Info_File_Exists then Write_Source_Info_File (Project_Tree); end if; diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index cc1650f..a80d149 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -823,6 +823,7 @@ package body System.Task_Primitives.Operations is -- processors for the domain. if T.Common.Domain /= null and then + T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then (T.Common.Base_CPU not in T.Common.Domain'Range or else not T.Common.Domain (T.Common.Base_CPU)) then diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index 861ef24..0d380da 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -895,12 +895,15 @@ package body System.Task_Primitives.Operations is Result : DWORD; Entry_Point : PTHREAD_START_ROUTINE; + use type System.Multiprocessors.CPU_Range; + begin -- Check whether both Dispatching_Domain and CPU are specified for the -- task, and the CPU value is not contained within the range of -- processors for the domain. if T.Common.Domain /= null and then + T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then (T.Common.Base_CPU not in T.Common.Domain'Range or else not T.Common.Domain (T.Common.Base_CPU)) then diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb index f77061d..042fed2 100644 --- a/gcc/ada/s-taprop-solaris.adb +++ b/gcc/ada/s-taprop-solaris.adb @@ -974,6 +974,7 @@ package body System.Task_Primitives.Operations is -- actual use. use System.Task_Info; + use type System.Multiprocessors.CPU_Range; begin -- Check whether both Dispatching_Domain and CPU are specified for the @@ -981,6 +982,7 @@ package body System.Task_Primitives.Operations is -- processors for the domain. if T.Common.Domain /= null and then + T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then (T.Common.Base_CPU not in T.Common.Domain'Range or else not T.Common.Domain (T.Common.Base_CPU)) then diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index 8637222..f0e9e03 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -890,12 +890,15 @@ package body System.Task_Primitives.Operations is is Adjusted_Stack_Size : size_t; + use type System.Multiprocessors.CPU_Range; + begin -- Check whether both Dispatching_Domain and CPU are specified for the -- task, and the CPU value is not contained within the range of -- processors for the domain. if T.Common.Domain /= null and then + T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then (T.Common.Base_CPU not in T.Common.Domain'Range or else not T.Common.Domain (T.Common.Base_CPU)) then diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index d759def..af9555d 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -10418,11 +10418,15 @@ package body Sem_Ch12 is and then not Is_Limited_Type (A_Gen_T) and then Ada_Version >= Ada_2012 then - Error_Msg_NE - ("actual for non-limited & cannot be a limited type", Actual, - Gen_T); - Explain_Limited_Type (Act_T, Actual); - Abandon_Instantiation (Actual); + if In_Instance then + null; + else + Error_Msg_NE + ("actual for non-limited & cannot be a limited type", Actual, + Gen_T); + Explain_Limited_Type (Act_T, Actual); + Abandon_Instantiation (Actual); + end if; end if; end Validate_Derived_Type_Instance; @@ -10556,11 +10560,15 @@ package body Sem_Ch12 is if Is_Limited_Type (Act_T) and then not Is_Limited_Type (A_Gen_T) then - Error_Msg_NE - ("actual for non-limited & cannot be a limited type", Actual, - Gen_T); - Explain_Limited_Type (Act_T, Actual); - Abandon_Instantiation (Actual); + if In_Instance then + null; + else + Error_Msg_NE + ("actual for non-limited & cannot be a limited type", Actual, + Gen_T); + Explain_Limited_Type (Act_T, Actual); + Abandon_Instantiation (Actual); + end if; elsif Known_To_Have_Preelab_Init (A_Gen_T) and then not Has_Preelaborable_Initialization (Act_T) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 25134b6..542ffee 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2868,8 +2868,8 @@ package body Sem_Ch3 is -- 2. Those generated by the Expression - -- 3. Those used to constrained the Object Definition with the - -- expression constraints when it is unconstrained + -- 3. Those used to constrain the Object Definition with the + -- expression constraints when the definition is unconstrained -- They must be generated in this order to avoid order of elaboration -- issues. Thus the first step (after entering the name) is to analyze @@ -17399,9 +17399,13 @@ package body Sem_Ch3 is and then (Is_Limited_Type (Full_T) or else Is_Limited_Composite (Full_T)) then - Error_Msg_N - ("completion of nonlimited type cannot be limited", Full_T); - Explain_Limited_Type (Full_T, Full_T); + if In_Instance then + null; + else + Error_Msg_N + ("completion of nonlimited type cannot be limited", Full_T); + Explain_Limited_Type (Full_T, Full_T); + end if; elsif Is_Abstract_Type (Full_T) and then not Is_Abstract_Type (Priv_T) diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 290b53d..242cfcb 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -7214,6 +7214,7 @@ package body Sem_Ch6 is function Get_Generic_Parent_Type (F_Typ : Entity_Id) return Entity_Id is G_Typ : Entity_Id; + Defn : Node_Id; Indic : Node_Id; begin @@ -7226,19 +7227,21 @@ package body Sem_Ch6 is -- is needed for cases where a full derived type has been -- rewritten.) - Indic := Subtype_Indication - (Type_Definition (Original_Node (Parent (F_Typ)))); + Defn := Type_Definition (Original_Node (Parent (F_Typ))); + if Nkind (Defn) = N_Derived_Type_Definition then + Indic := Subtype_Indication (Defn); - if Nkind (Indic) = N_Subtype_Indication then - G_Typ := Entity (Subtype_Mark (Indic)); - else - G_Typ := Entity (Indic); - end if; + if Nkind (Indic) = N_Subtype_Indication then + G_Typ := Entity (Subtype_Mark (Indic)); + else + G_Typ := Entity (Indic); + end if; - if Nkind (Parent (G_Typ)) = N_Subtype_Declaration - and then Present (Generic_Parent_Type (Parent (G_Typ))) - then - return Generic_Parent_Type (Parent (G_Typ)); + if Nkind (Parent (G_Typ)) = N_Subtype_Declaration + and then Present (Generic_Parent_Type (Parent (G_Typ))) + then + return Generic_Parent_Type (Parent (G_Typ)); + end if; end if; end if; @@ -7295,9 +7298,10 @@ package body Sem_Ch6 is and then In_Private_Part (Current_Scope) and then Comes_From_Source (New_E) then - -- We examine the formals and result subtype of the inherited - -- operation, to determine whether their type is derived from (the - -- instance of) a generic type. + -- We examine the formals and result type of the inherited operation, + -- to determine whether their type is derived from (the instance of) + -- a generic type. The first such formal or result type is the one + -- tested. Formal := First_Formal (Prev_E); while Present (Formal) loop @@ -7308,6 +7312,7 @@ package body Sem_Ch6 is end if; G_Typ := Get_Generic_Parent_Type (F_Typ); + exit when Present (G_Typ); Next_Formal (Formal); end loop;