+2010-06-18 Vincent Celier <celier@adacore.com>
+
+ * make.adb (Must_Compile): New Boolean global variable
+ (Main_On_Command_Line): New Boolean global variable
+ (Collect_Arguments_And_Compile): Do compile if Must_Compile is True,
+ even when the project is externally built.
+ (Start_Compile_If_Possible): Compile in -aL directories if
+ Check_Readonly_Files is True. Do compile if Must_Compile is True, even
+ when the project is externally built.
+ (Gnatmake): Set Must_Compile and Check_Readonly_Files to True when
+ invoked with -f -u and one or several mains on the command line.
+ (Scan_Make_Arg): Set Main_On_Command_Line to True when at least one main
+ is specified on the command line.
+
+2010-06-18 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch6.adb (Build_Body_For_Inline): Handle extended_return_statements
+ * exp_ch6.adb (Expand_Inlined_Call): when possible, inline a body
+ containing extented_return statements.
+ * exp_util.adb (Make_CW_Equivalent_Type): If the root type is already
+ constrained, do not build subtype declaration.
+
2010-06-18 Robert Dewar <dewar@adacore.com>
* sem_res.adb (Analyze_Indexed_Component, Analyze_Selected_Component):
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
Temp : Entity_Id;
Temp_Typ : Entity_Id;
+ Return_Object : Entity_Id := Empty;
+ -- Entity in declaration in an extended_return_statement
+
Is_Unc : constant Boolean :=
Is_Array_Type (Etype (Subp))
and then not Is_Constrained (Etype (Subp));
Rewrite (N, New_Copy (A));
end if;
end if;
+ return Skip;
+
+ elsif Is_Entity_Name (N)
+ and then Chars (N) = Chars (Return_Object)
+ then
+ -- Occurrence within an extended return statement. The return
+ -- object is local to the body been inlined, and thus the generic
+ -- copy is not analyzed yet, so we match by name, and replace it
+ -- with target of call.
+
+ if Nkind (Targ) = N_Defining_Identifier then
+ Rewrite (N, New_Occurrence_Of (Targ, Loc));
+ else
+ Rewrite (N, New_Copy_Tree (Targ));
+ end if;
return Skip;
if No (Expression (N)) then
Make_Exit_Label;
Rewrite (N,
- Make_Goto_Statement (Loc,
- Name => New_Copy (Lab_Id)));
+ Make_Goto_Statement (Loc, Name => New_Copy (Lab_Id)));
else
if Nkind (Parent (N)) = N_Handled_Sequence_Of_Statements
return OK;
+ elsif Nkind (N) = N_Extended_Return_Statement then
+
+ -- An extended return becomes a block whose first statement is
+ -- the assignment of the initial expression of the return object
+ -- to the target of the call itself.
+
+ declare
+ Return_Decl : constant Entity_Id :=
+ First (Return_Object_Declarations (N));
+ Assign : Node_Id;
+
+ begin
+ Return_Object := Defining_Identifier (Return_Decl);
+
+ if Present (Expression (Return_Decl)) then
+ if Nkind (Targ) = N_Defining_Identifier then
+ Assign :=
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Targ, Loc),
+ Expression => Expression (Return_Decl));
+ else
+ Assign :=
+ Make_Assignment_Statement (Loc,
+ Name => New_Copy (Targ),
+ Expression => Expression (Return_Decl));
+ end if;
+
+ Set_Assignment_OK (Name (Assign));
+ Prepend (Assign,
+ Statements (Handled_Statement_Sequence (N)));
+ end if;
+
+ Rewrite (N,
+ Make_Block_Statement (Loc,
+ Handled_Statement_Sequence =>
+ Handled_Statement_Sequence (N)));
+
+ return OK;
+ end;
+
-- Remove pragma Unreferenced since it may refer to formals that
-- are not visible in the inlined body, and in any case we will
-- not be posting warnings on the inlined body so it is unneeded.
then
Targ := Name (Parent (N));
+ elsif Nkind (Parent (N)) = N_Object_Declaration
+ and then Is_Limited_Type (Etype (Subp))
+ then
+ Targ := Defining_Identifier (Parent (N));
+
else
-- Replace call with temporary and create its declaration
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
Sizexpr : Node_Id;
begin
- if not Has_Discriminants (Root_Typ) then
+ -- If the root type is already constrained, there are no discriminants
+ -- in the expression.
+
+ if not Has_Discriminants (Root_Typ)
+ or else Is_Constrained (Root_Typ)
+ then
Constr_Root := Root_Typ;
else
Constr_Root := Make_Temporary (Loc, 'R');
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
Unique_Compile_All_Projects : Boolean := False;
-- Set to True if -U is used
+ Must_Compile : Boolean := False;
+ -- True if gnatmake is invoked with -f -u and one or several mains on the
+ -- command line.
+
+ Main_On_Command_Line : Boolean := False;
+ -- True if gnatmake is invoked with one or several mains on the command
+ -- line.
+
RTS_Specified : String_Access := null;
-- Used to detect multiple --RTS= switches
if Arguments_Project = No_Project then
Add_Arguments (The_Saved_Gcc_Switches.all);
- elsif not Arguments_Project.Externally_Built then
+ elsif not Arguments_Project.Externally_Built
+ or else Must_Compile
+ then
-- We get the project directory for the relative path
-- switches and arguments.
- Arguments_Project := Ultimate_Extending_Project_Of
- (Arguments_Project);
+ Arguments_Project :=
+ Ultimate_Extending_Project_Of (Arguments_Project);
-- If building a dynamic or relocatable library, compile with
-- PIC option, if it exists.
then
declare
PIC : constant String := MLib.Tgt.PIC_Option;
-
begin
if PIC /= "" then
Add_Arguments ((1 => new String'(PIC)));
-- check for an eventual library project, and use the full path.
if Arguments_Project /= No_Project then
- if not Arguments_Project.Externally_Built then
+ if not Arguments_Project.Externally_Built
+ or else Must_Compile
+ then
Prj.Env.Set_Ada_Paths
(Arguments_Project,
Project_Tree,
begin
if Prj.Library
- and then not Prj.Externally_Built
+ and then (not Prj.Externally_Built or else Must_Compile)
and then not Prj.Need_To_Build_Lib
then
-- Add to the Q all sources of the project that have
Executable_Obsolete := True;
end if;
- In_Lib_Dir := Full_Lib_File /= No_File
- and then In_Ada_Lib_Dir (Full_Lib_File);
+ In_Lib_Dir := not Check_Readonly_Files
+ and then Full_Lib_File /= No_File
+ and then In_Ada_Lib_Dir (Full_Lib_File);
-- Since the following requires a system call, we precompute it
-- when needed.
if Arguments_Project = No_Project
or else not Arguments_Project.Externally_Built
+ or else Must_Compile
then
-- Don't waste any time if we have to recompile anyway
Display_Version ("GNATMAKE", "1995");
end if;
- if Main_Project /= No_Project
- and then Main_Project.Externally_Built
- then
- Make_Failed
- ("nothing to do for a main project that is externally built");
- end if;
-
if Osint.Number_Of_Files = 0 then
if Main_Project /= No_Project
and then Main_Project.Library
end;
end if;
+ -- The combination of -f -u and one or several mains on the command line
+ -- implies -a.
+
+ if Force_Compilations
+ and then Unique_Compile
+ and then not Unique_Compile_All_Projects
+ and then Main_On_Command_Line
+ then
+ Check_Readonly_Files := True;
+ Must_Compile := True;
+ end if;
+
+ if Main_Project /= No_Project
+ and then not Must_Compile
+ and then Main_Project.Externally_Built
+ then
+ Make_Failed
+ ("nothing to do for a main project that is externally built");
+ end if;
+
-- Get the target parameters, which are only needed for a couple of
-- cases in gnatmake. Protect against an exception, such as the case of
-- system.ads missing from the library, and fail gracefully.
-- If not a switch it must be a file name
else
+ if And_Save then
+ Main_On_Command_Line := True;
+ end if;
+
Add_File (Argv);
Mains.Add_Main (Argv);
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
and then Has_Excluded_Statement (Statements (S))
then
return True;
+
+ elsif Nkind (S) = N_Extended_Return_Statement then
+ if Has_Excluded_Statement
+ (Statements (Handled_Statement_Sequence (S)))
+ or else Present
+ (Exception_Handlers (Handled_Statement_Sequence (S)))
+ then
+ return True;
+ end if;
end if;
Next (S);
return Abandon;
end if;
+ -- A return statement within an extended return is a noop
+ -- after inlining.
+
+ elsif No (Expression (N))
+ and then Nkind (Parent (Parent (N))) =
+ N_Extended_Return_Statement
+ then
+ return OK;
+
else
-- Expression has wrong form
return Abandon;
end if;
+ -- We can only inline a build-in-place function if
+ -- it has a single extended return.
+
+ elsif Nkind (N) = N_Extended_Return_Statement then
+ if No (Return_Statement) then
+ Return_Statement := N;
+ return OK;
+
+ else
+ return Abandon;
+ end if;
+
else
return OK;
end if;
-- Start of processing for Has_Single_Return
begin
- return Check_All_Returns (N) = OK
- and then Present (Declarations (N))
- and then Present (First (Declarations (N)))
- and then Chars (Expression (Return_Statement)) =
- Chars (Defining_Identifier (First (Declarations (N))));
+ if Check_All_Returns (N) /= OK then
+ return False;
+
+ elsif Nkind (Return_Statement) = N_Extended_Return_Statement then
+ return True;
+
+ else
+ return Present (Declarations (N))
+ and then Present (First (Declarations (N)))
+ and then Chars (Expression (Return_Statement)) =
+ Chars (Defining_Identifier (First (Declarations (N))));
+ end if;
end Has_Single_Return;
--------------------
Error_Msg_Sloc := Sloc (Overridden_Subp);
if Ekind (Subp) = E_Entry then
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX???
("entry & overrides inherited operation #", Spec, Subp);
else
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX???
("subprogram & overrides inherited operation #", Spec, Subp);
end if;
if not Is_Primitive
and then Ekind (Scope (Subp)) /= E_Protected_Type
then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX???
("overriding indicator only allowed "
& "if subprogram is primitive", Subp);
elsif Can_Override then
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX???
("subprogram & overrides predefined operator ",
Spec, Subp);
end if;
Set_Is_Overriding_Operation (Subp);
elsif not Can_Override then
- Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
+ Error_Msg_NE -- CODEFIX???
+ ("subprogram & is not overriding", Spec, Subp);
end if;
elsif not Error_Posted (Subp)
elsif Must_Override (Spec) then
if Ekind (Subp) = E_Entry then
- Error_Msg_NE ("entry & is not overriding", Spec, Subp);
+ Error_Msg_NE -- CODEFIX???
+ ("entry & is not overriding", Spec, Subp);
else
- Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
+ Error_Msg_NE -- CODEFIX???
+ ("subprogram & is not overriding", Spec, Subp);
end if;
-- If the operation is marked "not overriding" and it's not primitive
and then Ekind (Subp) /= E_Entry
and then Ekind (Scope (Subp)) /= E_Protected_Type
then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX???
("overriding indicator only allowed if subprogram is primitive",
Subp);
return;
projects / gcc.git / commitdiff