diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 49 | ||||
| -rw-r--r-- | gcc/ada/inline.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/prj-conf.adb | 100 | ||||
| -rw-r--r-- | gcc/ada/prj-conf.ads | 16 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 25 | ||||
| -rw-r--r-- | gcc/ada/prj-env.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 60 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/system-vxworks-x86.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/vxworks-x86-link.spec | 11 |
12 files changed, 264 insertions, 83 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f22d38b..e8a7143 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,52 @@ +2014-10-20 Eric Botcazou <ebotcazou@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <fofanov@adacore.com> + + * 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 <hainque@adacore.com> + + * 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 <celier@adacore.com> + + * 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 <schonberg@adacore.com> + + * 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 <schonberg@adacore.com> * sem_ch13.adb: Improve error recovery on illegal aspect. diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index c2e0f18..efb4e6c 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 ebf37b6..79c4d06 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 6d5cdc7..206fa4c 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_Again>> + -- 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 029310f..eae8f52 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 9dcd324..ac5b69f 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 043723b..08f2b40 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 1fd71fc..f0669f2 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 608307e..fcc6e1f 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,29 +2180,50 @@ 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); - - -- The type of the formal must be derived from [Limited_]Controlled + Typ := Parameter_Type (First (Params)); - if not Is_Controlled (Etype (Defining_Entity (First (Params)))) then + if Nkind (Typ) = N_Access_Definition then return; end if; - Spec_Id := Find_Corresponding_Spec (Body_Decl, Post_Error => False); + Find_Type (Typ); - -- The body has a matching spec, therefore it cannot be a late - -- primitive. + -- The type of the formal must be derived from [Limited_]Controlled - if Present (Spec_Id) then + if not Is_Controlled (Entity (Typ)) then return; end if; + -- 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. + + Spec_Id := Current_Entity (Body_Id); + + 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 -- use of Copy_Separate_Tree - we want an entirely separate semantic @@ -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 6c26031..167aae8 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 a2df22b..c5ce525 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 0000000..740476d --- /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) \ + } \ + }} |