+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.
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);
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;
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;
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;
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
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;
-- 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).
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);
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,
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;
--------------------------------------
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;
-- 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
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.
-- 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;
(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;
----------------
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
-- 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;
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 =>
when Object_Dir_Value | Target_Value =>
null;
end case;
- end case;
+ end case;
+ end if;
end;
end if;
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
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
-- 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;
---------------------------
procedure Process_Function_Call is
+ Loc : constant Source_Ptr := Sloc (N);
Actual : Node_Id;
begin
-- 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);
-- 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 --
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;
--- /dev/null
+*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) \
+ } \
+ }}
projects / gcc.git / commitdiff