From 1725676d08348f92dd1297cf79365ca69c759f31 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 20 Oct 2014 16:17:37 +0200 Subject: [PATCH] [multiple changes] 2014-10-20 Eric Botcazou * inline.adb (List_Inlining_Info): Minor tweaks. (Add_Inlined_Body): Inline the enclosing package if it is not internally generated, even if it doesn't come from source. 2014-10-20 Ed Schonberg * sem_ch4.adb (Process_Function_Call): If the first actual denotes a discrete type, the mode must be interpreted as a slice of an array returned by a parameterless call. 2014-10-20 Vasiliy Fofanov * prj-env.ads, prj-env.adb (Get_Runtime_Path): No longer inhibit searching for runtime referenced by a simple name on a project path. 2014-10-20 Olivier Hainque * vxworks-x86-link.spec: New file. * system-vxworks-x86.ads: Add pragma Linker_Options to link with vxworks-x86-link.spec. 2014-10-20 Vincent Celier * opt.ads (Origin_Of_Target): New type. (Target_Origin): New variable. * prj-conf.adb (Parse_Project_And_Apply_Config): Record Target_Value and Target_Origin. If target was not specified on the command line with --target=, check if attribute Target is declared in the main project. If it is and it is not the native target, parse again the projects so that 'Target get the new value. Fail if the target has changed again. Invoke Process_Project_And_Apply_Config with Do_Phase_1 set to False is Process_Project_Tree_Phase_1 has already been invoked. * prj-conf.ads (Process_Project_And_Apply_Config): New Boolean parameter Do_Phase_1, defaulted to True. * prj-proc.adb (Expression): Check the special values and defaults for attribute Target. 2014-10-20 Ed Schonberg * sem_ch3.adb (Handle_Late_Controlled_Primitive): Do not analyze the subprogram spec of the body in full, because it will be reanalyzed when the declaration itself is analyzed; otherwise. a formal may end up duplicated in the list of formals leading to spurious conformance errors with an existing declaration. From-SVN: r216473 --- gcc/ada/ChangeLog | 49 ++++++++++++++++ gcc/ada/inline.adb | 12 ++-- gcc/ada/opt.ads | 10 ++++ gcc/ada/prj-conf.adb | 100 +++++++++++++++++++++++++++------ gcc/ada/prj-conf.ads | 16 ++++-- gcc/ada/prj-env.adb | 25 +-------- gcc/ada/prj-env.ads | 6 +- gcc/ada/prj-proc.adb | 31 ++++++++-- gcc/ada/sem_ch3.adb | 60 +++++++++++++------- gcc/ada/sem_ch4.adb | 22 +++++++- gcc/ada/system-vxworks-x86.ads | 5 +- gcc/ada/vxworks-x86-link.spec | 11 ++++ 12 files changed, 264 insertions(+), 83 deletions(-) create mode 100644 gcc/ada/vxworks-x86-link.spec diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f22d38bbd96..e8a7143a044 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,52 @@ +2014-10-20 Eric Botcazou + + * inline.adb (List_Inlining_Info): Minor tweaks. + (Add_Inlined_Body): Inline the enclosing package + if it is not internally generated, even if it doesn't come + from source. + +2014-10-20 Ed Schonberg + + * sem_ch4.adb (Process_Function_Call): If the first actual + denotes a discrete type, the mode must be interpreted as a slice + of an array returned by a parameterless call. + +2014-10-20 Vasiliy Fofanov + + * prj-env.ads, prj-env.adb (Get_Runtime_Path): No longer inhibit + searching for runtime referenced by a simple name on a project path. + +2014-10-20 Olivier Hainque + + * vxworks-x86-link.spec: New file. + * system-vxworks-x86.ads: Add pragma Linker_Options to link with + vxworks-x86-link.spec. + +2014-10-20 Vincent Celier + + * opt.ads (Origin_Of_Target): New type. + (Target_Origin): New variable. + * prj-conf.adb (Parse_Project_And_Apply_Config): Record + Target_Value and Target_Origin. If target was not specified + on the command line with --target=, check if attribute Target + is declared in the main project. If it is and it is not the + native target, parse again the projects so that 'Target get + the new value. Fail if the target has changed again. Invoke + Process_Project_And_Apply_Config with Do_Phase_1 set to False + is Process_Project_Tree_Phase_1 has already been invoked. + * prj-conf.ads (Process_Project_And_Apply_Config): New Boolean + parameter Do_Phase_1, defaulted to True. + * prj-proc.adb (Expression): Check the special values and + defaults for attribute Target. + +2014-10-20 Ed Schonberg + + * sem_ch3.adb (Handle_Late_Controlled_Primitive): Do not analyze + the subprogram spec of the body in full, because it will be + reanalyzed when the declaration itself is analyzed; otherwise. a + formal may end up duplicated in the list of formals leading to + spurious conformance errors with an existing declaration. + 2014-10-20 Ed Schonberg * sem_ch13.adb: Improve error recovery on illegal aspect. diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index c2e0f18a0ea..efb4e6cd0f3 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -414,7 +414,7 @@ package body Inline is elsif Level = Inline_Package and then not Is_Inlined (Pack) - and then Comes_From_Source (E) + and then not Is_Internal (E) and then not In_Main_Unit_Or_Subunit (Pack) then Set_Is_Inlined (Pack); @@ -3888,7 +3888,7 @@ package body Inline is Count := Count + 1; if Count = 1 then - Write_Str ("Listing of frontend inlined calls"); + Write_Str ("List of calls inlined by the frontend"); Write_Eol; end if; @@ -3917,7 +3917,7 @@ package body Inline is Count := Count + 1; if Count = 1 then - Write_Str ("Listing of inlined calls passed to the backend"); + Write_Str ("List of inlined calls passed to the backend"); Write_Eol; end if; @@ -3947,7 +3947,7 @@ package body Inline is if Count = 1 then Write_Str - ("Listing of inlined subprograms passed to the backend"); + ("List of inlined subprograms passed to the backend"); Write_Eol; end if; @@ -3964,7 +3964,7 @@ package body Inline is end loop; end if; - -- Generate listing of subprogram that cannot be inlined by the backend + -- Generate listing of subprograms that cannot be inlined by the backend if Present (Backend_Not_Inlined_Subps) and then Back_End_Inlining @@ -3979,7 +3979,7 @@ package body Inline is if Count = 1 then Write_Str - ("Listing of subprograms that cannot inline the backend"); + ("List of subprograms that cannot be inlined by the backend"); Write_Eol; end if; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index ebf37b6da16..79c4d0658d7 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1418,6 +1418,16 @@ package Opt is -- Get_Targ and Set_Targ for full details) using the name given by -- this switch. Set to non-null file name by use of the -gnatet switch. + type Origin_Of_Target is (Unknown, Default, Specified); + + Target_Origin : Origin_Of_Target := Unknown; + -- GPRBUILD + -- Indicates the origin of attribute Target in project files + + Target_Value : String_Access := null; + -- GPRBUILD + -- Indicates the value of attribute Target in project files + Task_Dispatching_Policy : Character := ' '; -- GNAT, GNATBIND -- Set to ' ' for the default case (no task dispatching policy specified). diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 6d5cdc7cc15..206fa4c7228 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -1584,9 +1584,24 @@ package body Prj.Conf is Implicit_Project : Boolean := False; On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null) is + Success : Boolean := False; + Try_Again : Boolean := True; + begin pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path)); + -- Record Target_Value and Target_Origin. + + if Target_Name = "" then + Opt.Target_Value := new String'(Normalized_Hostname); + Opt.Target_Origin := Default; + else + Opt.Target_Value := new String'(Target_Name); + Opt.Target_Origin := Specified; + end if; + + <> + -- Parse the user project tree Prj.Initialize (Project_Tree); @@ -1609,6 +1624,55 @@ package body Prj.Conf is return; end if; + -- If --target was not specified on the command line, then do Phase 1 to + -- check if attribute Target is declared in the main project. + + if Opt.Target_Origin /= Specified then + Main_Project := No_Project; + Process_Project_Tree_Phase_1 + (In_Tree => Project_Tree, + Project => Main_Project, + Packages_To_Check => Packages_To_Check, + Success => Success, + From_Project_Node => User_Project_Node, + From_Project_Node_Tree => Project_Node_Tree, + Env => Env, + Reset_Tree => True, + On_New_Tree_Loaded => On_New_Tree_Loaded); + + if not Success then + Main_Project := No_Project; + return; + end if; + + declare + Variable : constant Variable_Value := + Value_Of + (Name_Target, + Main_Project.Decl.Attributes, + Project_Tree.Shared); + begin + if Variable /= Nil_Variable_Value + and then not Variable.Default + and then + Get_Name_String (Variable.Value) /= Opt.Target_Value.all + then + if Try_Again then + Opt.Target_Value := + new String'(Get_Name_String (Variable.Value)); + Try_Again := False; + goto Parse_Again; + + else + Fail_Program + (Project_Tree, + "inconsistent value of attribute Target"); + end if; + end if; + end; + + end if; + Process_Project_And_Apply_Config (Main_Project => Main_Project, User_Project_Node => User_Project_Node, @@ -1624,7 +1688,8 @@ package body Prj.Conf is Target_Name => Target_Name, Normalized_Hostname => Normalized_Hostname, On_Load_Config => On_Load_Config, - On_New_Tree_Loaded => On_New_Tree_Loaded); + On_New_Tree_Loaded => On_New_Tree_Loaded, + Do_Phase_1 => Opt.Target_Origin = Specified); end Parse_Project_And_Apply_Config; -------------------------------------- @@ -1647,7 +1712,8 @@ package body Prj.Conf is Normalized_Hostname : String; On_Load_Config : Config_File_Hook := null; Reset_Tree : Boolean := True; - On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null) + On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null; + Do_Phase_1 : Boolean := True) is Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared; @@ -1692,23 +1758,25 @@ package body Prj.Conf is -- Start of processing for Process_Project_And_Apply_Config begin - Main_Project := No_Project; Automatically_Generated := False; - Process_Project_Tree_Phase_1 - (In_Tree => Project_Tree, - Project => Main_Project, - Packages_To_Check => Packages_To_Check, - Success => Success, - From_Project_Node => User_Project_Node, - From_Project_Node_Tree => Project_Node_Tree, - Env => Env, - Reset_Tree => Reset_Tree, - On_New_Tree_Loaded => On_New_Tree_Loaded); - - if not Success then + if Do_Phase_1 then Main_Project := No_Project; - return; + Process_Project_Tree_Phase_1 + (In_Tree => Project_Tree, + Project => Main_Project, + Packages_To_Check => Packages_To_Check, + Success => Success, + From_Project_Node => User_Project_Node, + From_Project_Node_Tree => Project_Node_Tree, + Env => Env, + Reset_Tree => Reset_Tree, + On_New_Tree_Loaded => On_New_Tree_Loaded); + + if not Success then + Main_Project := No_Project; + return; + end if; end if; if Project_Tree.Source_Info_File_Name /= null then diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads index 029310f9dd1..eae8f528162 100644 --- a/gcc/ada/prj-conf.ads +++ b/gcc/ada/prj-conf.ads @@ -112,20 +112,21 @@ package Prj.Conf is procedure Process_Project_And_Apply_Config (Main_Project : out Prj.Project_Id; User_Project_Node : Prj.Tree.Project_Node_Id; - Config_File_Name : String := ""; + Config_File_Name : String := ""; Autoconf_Specified : Boolean; Project_Tree : Prj.Project_Tree_Ref; Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref; Env : in out Prj.Tree.Environment; Packages_To_Check : String_List_Access; - Allow_Automatic_Generation : Boolean := True; + Allow_Automatic_Generation : Boolean := True; Automatically_Generated : out Boolean; Config_File_Path : out String_Access; - Target_Name : String := ""; + Target_Name : String := ""; Normalized_Hostname : String; - On_Load_Config : Config_File_Hook := null; - Reset_Tree : Boolean := True; - On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null); + On_Load_Config : Config_File_Hook := null; + Reset_Tree : Boolean := True; + On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null; + Do_Phase_1 : Boolean := True); -- Same as above, except the project must already have been parsed through -- Prj.Part.Parse, and only the processing of the project and the -- configuration is done at this level. @@ -138,6 +139,9 @@ package Prj.Conf is -- least one source file, or an error is reported via When_No_Sources. If -- it is false, this is only required for Ada (and only if it is a language -- of the project). + -- + -- If Do_Phase_1 is False, then Prj.Proc.Process_Project_Tree_Phase_1 + -- should not be called, as it has already been invoked successfully. Invalid_Config : exception; diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 9dcd3249e1e..ac5b69f0a97 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -1425,35 +1425,12 @@ package body Prj.Env is (Self : Project_Search_Path; Name : String) return String_Access is - function Is_Base_Name (Path : String) return Boolean; - -- Returns True if Path has no directory separator - - ------------------ - -- Is_Base_Name -- - ------------------ - - function Is_Base_Name (Path : String) return Boolean is - begin - for J in Path'Range loop - if Is_Directory_Separator (Path (J)) then - return False; - end if; - end loop; - - return True; - end Is_Base_Name; function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path (Check_Filename => Is_Directory); - -- Start of processing for Get_Runtime_Path - begin - if not Is_Base_Name (Name) then - return Find_Rts_In_Path (Self, Name); - else - return null; - end if; + return Find_Rts_In_Path (Self, Name); end Get_Runtime_Path; ---------------- diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 043723b6b6b..08f2b400f6b 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -243,10 +243,8 @@ package Prj.Env is function Get_Runtime_Path (Self : Project_Search_Path; Name : String) return String_Access; - -- Compute the full path for the project-based runtime name. It first - -- checks that Name is not a simple file name (must have a path separator - -- in it), and returns null in case of failure. This check might be removed - -- in the future. Name is simply searched on the project path. + -- Compute the full path for the project-based runtime name. + -- Name is simply searched on the project path. private package Projects_Paths is new GNAT.Dynamic_HTables.Simple_HTable diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 1fd71fc5dfd..f0669f2a294 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -889,16 +889,26 @@ package body Prj.Proc is -- Check the defaults - if Current_Term_Kind = N_Attribute_Reference - and then The_Variable.Default - then + if Current_Term_Kind = N_Attribute_Reference then declare The_Default : constant Attribute_Default_Value := Default_Of (The_Current_Term, From_Project_Node_Tree); begin - case The_Variable.Kind is + -- Check the special value for 'Target when specified + + if The_Default = Target_Value + and then Opt.Target_Origin = Specified + then + Name_Len := 0; + Add_Str_To_Name_Buffer (Opt.Target_Value.all); + The_Variable.Value := Name_Find; + + -- Check the defaults + + elsif The_Variable.Default then + case The_Variable.Kind is when Undefined => null; @@ -923,7 +933,15 @@ package body Prj.Proc is goto Object_Dir_Restart; when Target_Value => - null; + if Opt.Target_Value = null then + The_Variable.Value := Empty_String; + + else + Name_Len := 0; + Add_Str_To_Name_Buffer + (Opt.Target_Value.all); + The_Variable.Value := Name_Find; + end if; end case; when List => @@ -941,7 +959,8 @@ package body Prj.Proc is when Object_Dir_Value | Target_Value => null; end case; - end case; + end case; + end if; end; end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 608307e4470..fcc6e1f9ac2 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2167,10 +2167,7 @@ package body Sem_Ch3 is Parameter_Specifications (Body_Spec); Spec : Node_Id; Spec_Id : Entity_Id; - - Dummy : Entity_Id; - -- A dummy variable used to capture the unused result of subprogram - -- spec analysis. + Typ : Node_Id; begin -- Consider only procedure bodies whose name matches one of the three @@ -2183,28 +2180,49 @@ package body Sem_Ch3 is then return; - -- A controlled primitive must have exactly one formal + -- A controlled primitive must have exactly one formal which is not + -- an anonymous access type. elsif List_Length (Params) /= 1 then return; end if; - Dummy := Analyze_Subprogram_Specification (Body_Spec); + Typ := Parameter_Type (First (Params)); + + if Nkind (Typ) = N_Access_Definition then + return; + end if; + + Find_Type (Typ); -- The type of the formal must be derived from [Limited_]Controlled - if not Is_Controlled (Etype (Defining_Entity (First (Params)))) then + if not Is_Controlled (Entity (Typ)) then return; end if; - Spec_Id := Find_Corresponding_Spec (Body_Decl, Post_Error => False); + -- Check whether a specification exists for this body. We do not + -- analyze the spec of the body in full, because it will be analyzed + -- again when the body is properly analyzed, and we cannot create + -- duplicate entries in the formals chain. We look for an explicit + -- specification because the body may be an overriding operation and + -- an inherited spec may be present. - -- The body has a matching spec, therefore it cannot be a late - -- primitive. + Spec_Id := Current_Entity (Body_Id); - if Present (Spec_Id) then - return; - end if; + while Present (Spec_Id) loop + if Ekind_In (Spec_Id, E_Procedure, E_Generic_Procedure) + and then Scope (Spec_Id) = Current_Scope + and then Present (First_Formal (Spec_Id)) + and then No (Next_Formal (First_Formal (Spec_Id))) + and then Etype (First_Formal (Spec_Id)) = Entity (Typ) + and then Comes_From_Source (Spec_Id) + then + return; + end if; + + Spec_Id := Homonym (Spec_Id); + end loop; -- At this point the body is known to be a late controlled primitive. -- Generate a matching spec and insert it before the body. Note the @@ -2777,18 +2795,22 @@ package body Sem_Ch3 is -- them to the entity for the type which is currently the partial -- view, but which is the one that will be frozen. - -- In most cases the partial view is a private type, and both views - -- appear in different declarative parts. In the unusual case where the - -- partial view is incomplete, perform the analysis on the full view, - -- to prevent freezing anomalies with the corresponding class-wide type, - -- which otherwise might be frozen before the dispatch table is built. - if Has_Aspects (N) then + + -- In most cases the partial view is a private type, and both views + -- appear in different declarative parts. In the unusual case where + -- the partial view is incomplete, perform the analysis on the + -- full view, to prevent freezing anomalies with the corresponding + -- class-wide type, which otherwise might be frozen before the + -- dispatch table is built. + if Prev /= Def_Id and then Ekind (Prev) /= E_Incomplete_Type then Analyze_Aspect_Specifications (N, Prev); + -- Normal case + else Analyze_Aspect_Specifications (N, Def_Id); end if; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 6c260313c9c..167aae85c73 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -2156,6 +2156,7 @@ package body Sem_Ch4 is --------------------------- procedure Process_Function_Call is + Loc : constant Source_Ptr := Sloc (N); Actual : Node_Id; begin @@ -2187,7 +2188,26 @@ package body Sem_Ch4 is -- subsequent crashes or loops if there is an attempt to continue -- analysis of the program. - Next (Actual); + -- IF there is a single actual and it is a type name, the node + -- can only be interpreted as a slice of a parameterless call. + -- Rebuild the node as such and analyze. + + if No (Next (Actual)) + and then Is_Entity_Name (Actual) + and then Is_Type (Entity (Actual)) + and then Is_Discrete_Type (Entity (Actual)) + then + Replace (N, + Make_Slice (Loc, + Prefix => P, + Discrete_Range => + New_Occurrence_Of (Entity (Actual), Loc))); + Analyze (N); + return; + + else + Next (Actual); + end if; end loop; Analyze_Call (N); diff --git a/gcc/ada/system-vxworks-x86.ads b/gcc/ada/system-vxworks-x86.ads index a2df22b038c..c5ce5259870 100644 --- a/gcc/ada/system-vxworks-x86.ads +++ b/gcc/ada/system-vxworks-x86.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (VxWorks 5 Version x86) -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -115,6 +115,9 @@ package System is private + pragma Linker_Options ("--specs=vxworks-x86-link.spec"); + -- Setup proper set of -L's for this configuration + type Address is mod Memory_Size; Null_Address : constant Address := 0; diff --git a/gcc/ada/vxworks-x86-link.spec b/gcc/ada/vxworks-x86-link.spec new file mode 100644 index 00000000000..740476db945 --- /dev/null +++ b/gcc/ada/vxworks-x86-link.spec @@ -0,0 +1,11 @@ +*lib: ++ %{mrtp:%{!shared: \ + %{vxsim: \ + -L%:getenv(WIND_BASE /target/usr/lib/simpentium/SIMPENTIUM/common) \ + -L%:getenv(WIND_BASE /target/lib/usr/lib/simpentium/SIMPENTIUM/common) \ + } \ + %{!vxsim: \ + -L%:getenv(WIND_BASE /target/usr/lib/pentium/PENTIUM/common) \ + -L%:getenv(WIND_BASE /target/lib/usr/lib/pentium/PENTIUM/common) \ + } \ + }}