OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2011-08-04  Yannick Moy  <moy@adacore.com>

	* sem_attr.adb (Result): modify error message for misplaced 'Result

2011-08-04  Sergey Rybin  <rybin@adacore.com>

	* gnat_rm.texi (pragma Annotate): Fix syntax description to make it
	clear that the second argument must be an identifier.

2011-08-04  Thomas Quinot  <quinot@adacore.com>

	* exp_ch9.adb (Build_Barrier_Function): When compiling with
	-fpreserve-control-flow, insert an IF statement on the barrier
	condition to ensure that a conditional branch instruction is generated.

2011-08-04  Emmanuel Briot  <briot@adacore.com>

	* prj-part.adb, prj.adb, prj.ads, prj-tree.ads
	(Processing_Flags.Ignore_Missing_With): new flag.

2011-08-04  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb (Find_Sources, Path_Name_Of): Fix handling of
	Source_List_File on case-insensitive systems where the file is actually
	on a case-sensitive file system (NFS,...).

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch6.adb (Analyze_Function_Return): In a rare case where a
	function return contains a controlled [extension] aggregate and the
	return statement is not part of a handled sequence of statements, wrap
	the return in a block. This ensures that all controlled temporaries
	generated during aggregate resolution will be picked up by the
	finalization machinery.

2011-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Resolve_Aggregate): If aggregate has box-initialized
	components, freeze type before resolution, to ensure that default
	initializations are present for all components.
	* sem_res.adb (Resolve_Actuals): the designated object of an
	accces-to-constant type is a legal actual in a call to an
	initialization procedure.

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb (Extract_Renamed_Object): Add N_Type_Conversion and
	N_Unchecked_Type_Conversion to the possible containers of a renamed
	transient variable.

From-SVN: r177343
This commit is contained in:
Arnaud Charlet 2011-08-04 11:22:03 +02:00
parent 78efd71259
commit 0180fd267e
13 changed files with 200 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
gcc/ada/ChangeLog
View File

@ -1,3 +1,53 @@
2011-08-04 Yannick Moy <moy@adacore.com>
* sem_attr.adb (Result): modify error message for misplaced 'Result
2011-08-04 Sergey Rybin <rybin@adacore.com>
* gnat_rm.texi (pragma Annotate): Fix syntax description to make it
clear that the second argument must be an identifier.
2011-08-04 Thomas Quinot <quinot@adacore.com>
* exp_ch9.adb (Build_Barrier_Function): When compiling with
-fpreserve-control-flow, insert an IF statement on the barrier
condition to ensure that a conditional branch instruction is generated.
2011-08-04 Emmanuel Briot <briot@adacore.com>
* prj-part.adb, prj.adb, prj.ads, prj-tree.ads
(Processing_Flags.Ignore_Missing_With): new flag.
2011-08-04 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb (Find_Sources, Path_Name_Of): Fix handling of
Source_List_File on case-insensitive systems where the file is actually
on a case-sensitive file system (NFS,...).
2011-08-04 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch6.adb (Analyze_Function_Return): In a rare case where a
function return contains a controlled [extension] aggregate and the
return statement is not part of a handled sequence of statements, wrap
the return in a block. This ensures that all controlled temporaries
generated during aggregate resolution will be picked up by the
finalization machinery.
2011-08-04 Ed Schonberg <schonberg@adacore.com>
* sem_aggr.adb (Resolve_Aggregate): If aggregate has box-initialized
components, freeze type before resolution, to ensure that default
initializations are present for all components.
* sem_res.adb (Resolve_Actuals): the designated object of an
accces-to-constant type is a legal actual in a call to an
initialization procedure.
2011-08-04 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb (Extract_Renamed_Object): Add N_Type_Conversion and
N_Unchecked_Type_Conversion to the possible containers of a renamed
transient variable.
2011-08-04 Yannick Moy <moy@adacore.com>
* par-ch13.adb (Aspect_Specifications_Present): recognize

39
gcc/ada/exp_ch9.adb
View File

@ -921,10 +921,12 @@ package body Exp_Ch9 is
Ent : Entity_Id;
Pid : Node_Id) return Node_Id
is
Loc : constant Source_Ptr := Sloc (N);
Func_Id : constant Entity_Id := Barrier_Function (Ent);
Ent_Formals : constant Node_Id := Entry_Body_Formal_Part (N);
Cond : constant Node_Id := Condition (Ent_Formals);
Loc : constant Source_Ptr := Sloc (Cond);
Func_Id : constant Entity_Id := Barrier_Function (Ent);
Op_Decls : constant List_Id := New_List;
Stmt : Node_Id;
Func_Body : Node_Id;
begin
@ -932,8 +934,33 @@ package body Exp_Ch9 is
-- for the discriminals and privals and finally a declaration for the
-- entry family index (if applicable).
Install_Private_Data_Declarations
(Loc, Func_Id, Pid, N, Op_Decls, True, Ekind (Ent) = E_Entry_Family);
Install_Private_Data_Declarations (Sloc (N),
Spec_Id => Func_Id,
Conc_Typ => Pid,
Body_Nod => N,
Decls => Op_Decls,
Barrier => True,
Family => Ekind (Ent) = E_Entry_Family);
-- If compiling with -fpreserve-control-flow, make sure we insert an
-- IF statement so that the back-end knows to generate a conditional
-- branch instruction, even if the condition is just the name of a
-- boolean object.
if Opt.Suppress_Control_Flow_Optimizations then
Stmt := Make_Implicit_If_Statement (Cond,
Condition =>
Cond,
Then_Statements => New_List (
Make_Simple_Return_Statement (Loc,
New_Occurrence_Of (Standard_True, Loc))),
Else_Statements => New_List (
Make_Simple_Return_Statement (Loc,
New_Occurrence_Of (Standard_False, Loc))));
else
Stmt := Make_Simple_Return_Statement (Loc, Cond);
end if;
-- Note: the condition in the barrier function needs to be properly
-- processed for the C/Fortran boolean possibility, but this happens
@ -947,9 +974,7 @@ package body Exp_Ch9 is
Declarations => Op_Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (
Make_Simple_Return_Statement (Loc,
Expression => Condition (Ent_Formals)))));
Statements => New_List (Stmt)));
Set_Is_Entry_Barrier_Function (Func_Body);
return Func_Body;

8
gcc/ada/exp_util.adb
View File

@ -3888,7 +3888,13 @@ package body Exp_Util is
N_Selected_Component)
then
Ren_Obj := Prefix (Ren_Obj);
Change := True;
Change := True;
elsif Nkind_In (Ren_Obj, N_Type_Conversion,
N_Unchecked_Type_Conversion)
then
Ren_Obj := Expression (Ren_Obj);
Change := True;
end if;
end loop;

2
gcc/ada/gnat_rm.texi
View File

@ -984,7 +984,7 @@ same syntax and effect.
@noindent
Syntax:
@smallexample @c ada
pragma Annotate (IDENTIFIER [,IDENTIFIER] @{, ARG@});
pragma Annotate (IDENTIFIER [,IDENTIFIER @{, ARG@}]);
ARG ::= NAME | EXPRESSION
@end smallexample

8
gcc/ada/prj-nmsc.adb
View File

@ -6262,7 +6262,7 @@ package body Prj.Nmsc is
Source_File_Path_Name : constant String :=
Path_Name_Of
(File_Name_Type (Source_List_File.Value),
Project.Project.Directory.Name);
Project.Project.Directory.Display_Name);
begin
Has_Explicit_Sources := True;
@ -7819,6 +7819,9 @@ package body Prj.Nmsc is
The_Directory : constant String := Get_Name_String (Directory);
begin
Debug_Output ("Path_Name_Of file_name=", Name_Id (File_Name));
Debug_Output ("Path_Name_Of directory=",
Name_Id (Directory));
Get_Name_String (File_Name);
Result :=
Locate_Regular_File
@ -7829,10 +7832,9 @@ package body Prj.Nmsc is
return "";
else
declare
R : String := Result.all;
R : constant String := Result.all;
begin
Free (Result);
Canonical_Case_File_Name (R);
return R;
end;
end if;

35
gcc/ada/prj-part.adb
View File

@ -460,6 +460,8 @@ package body Prj.Part is
Path_Name_Id : Path_Name_Type;
begin
In_Tree.Incomplete_With := False;
if not Is_Initialized (Env.Project_Path) then
Prj.Env.Initialize_Default_Project_Path
(Env.Project_Path, Target_Name);
@ -794,24 +796,29 @@ package body Prj.Part is
Path => Imported_Path_Name_Id);
if Imported_Path_Name_Id = No_Path then
if Env.Flags.Ignore_Missing_With then
In_Tree.Incomplete_With := True;
-- The project file cannot be found
else
-- The project file cannot be found
Error_Msg_File_1 := File_Name_Type (Current_With.Path);
Error_Msg
(Env.Flags, "unknown project file: {", Current_With.Location);
Error_Msg_File_1 := File_Name_Type (Current_With.Path);
Error_Msg
(Env.Flags, "unknown project file: {",
Current_With.Location);
-- If this is not imported by the main project file, display
-- the import path.
-- If this is not imported by the main project file, display
-- the import path.
if Project_Stack.Last > 1 then
for Index in reverse 1 .. Project_Stack.Last loop
Error_Msg_File_1 :=
File_Name_Type
(Project_Stack.Table (Index).Path_Name);
Error_Msg
(Env.Flags, "\imported by {", Current_With.Location);
end loop;
if Project_Stack.Last > 1 then
for Index in reverse 1 .. Project_Stack.Last loop
Error_Msg_File_1 :=
File_Name_Type
(Project_Stack.Table (Index).Path_Name);
Error_Msg
(Env.Flags, "\imported by {", Current_With.Location);
end loop;
end if;
end if;
else

5
gcc/ada/prj-tree.ads
View File

@ -1505,6 +1505,11 @@ package Prj.Tree is
type Project_Node_Tree_Data is record
Project_Nodes : Tree_Private_Part.Project_Node_Table.Instance;
Projects_HT : Tree_Private_Part.Projects_Htable.Instance;
Incomplete_With : Boolean := False;
-- Set to True if the projects were loaded with the flag
-- Ignore_Missing_With set to True, and there were indeed some with
-- statements that could not be resolved
end record;
procedure Free (Proj : in out Project_Node_Tree_Ref);

6
gcc/ada/prj.adb
View File

@ -1377,7 +1377,8 @@ package body Prj is
Error_On_Unknown_Language : Boolean := True;
Require_Obj_Dirs : Error_Warning := Error;
Allow_Invalid_External : Error_Warning := Error;
Missing_Source_Files : Error_Warning := Error)
Missing_Source_Files : Error_Warning := Error;
Ignore_Missing_With : Boolean := False)
return Processing_Flags
is
begin
@ -1390,7 +1391,8 @@ package body Prj is
Compiler_Driver_Mandatory => Compiler_Driver_Mandatory,
Require_Obj_Dirs => Require_Obj_Dirs,
Allow_Invalid_External => Allow_Invalid_External,
Missing_Source_Files => Missing_Source_Files);
Missing_Source_Files => Missing_Source_Files,
Ignore_Missing_With => Ignore_Missing_With);
end Create_Flags;
------------

23
gcc/ada/prj.ads
View File

@ -1630,7 +1630,8 @@ package Prj is
Error_On_Unknown_Language : Boolean := True;
Require_Obj_Dirs : Error_Warning := Error;
Allow_Invalid_External : Error_Warning := Error;
Missing_Source_Files : Error_Warning := Error)
Missing_Source_Files : Error_Warning := Error;
Ignore_Missing_With : Boolean := False)
return Processing_Flags;
-- Function used to create Processing_Flags structure
--
@ -1668,6 +1669,16 @@ package Prj is
-- a source file mentioned in the Source_Files attributes is not actually
-- found in the source directories. This also impacts errors for missing
-- source directories.
--
-- If Ignore_Missing_With is True, then a "with" statement that cannot be
-- resolved will simply be ignored. However, in such a case, the flag
-- Incomplete_With in the project tree will be set to True.
-- This is meant for use by tools so that they can properly set the
-- project path in such a case:
-- * no "gnatls" found (so no default project path)
-- * user project sets Project.IDE'gnatls attribute to a cross gnatls
-- * user project also includes a "with" that can only be resolved
-- once we have found the gnatls
Gprbuild_Flags : constant Processing_Flags;
Gprclean_Flags : constant Processing_Flags;
@ -1813,6 +1824,7 @@ private
Require_Obj_Dirs : Error_Warning;
Allow_Invalid_External : Error_Warning;
Missing_Source_Files : Error_Warning;
Ignore_Missing_With : Boolean;
end record;
Gprbuild_Flags : constant Processing_Flags :=
@ -1824,7 +1836,8 @@ private
Error_On_Unknown_Language => True,
Require_Obj_Dirs => Error,
Allow_Invalid_External => Error,
Missing_Source_Files => Error);
Missing_Source_Files => Error,
Ignore_Missing_With => False);
Gprclean_Flags : constant Processing_Flags :=
(Report_Error => null,
@ -1835,7 +1848,8 @@ private
Error_On_Unknown_Language => True,
Require_Obj_Dirs => Warning,
Allow_Invalid_External => Error,
Missing_Source_Files => Error);
Missing_Source_Files => Error,
Ignore_Missing_With => False);
Gnatmake_Flags : constant Processing_Flags :=
(Report_Error => null,
@ -1846,6 +1860,7 @@ private
Error_On_Unknown_Language => False,
Require_Obj_Dirs => Error,
Allow_Invalid_External => Error,
Missing_Source_Files => Error);
Missing_Source_Files => Error,
Ignore_Missing_With => False);
end Prj;

24
gcc/ada/sem_aggr.adb
View File

@ -978,6 +978,30 @@ package body Sem_Aggr is
return;
end if;
-- If the aggregate has box-initialized components, its type must be
-- frozen so that initialization procedures can properly be called
-- in the resolution that follows. The replacement of boxes with
-- initialization calls is properly an expansion activity but it must
-- be done during revolution.
if Expander_Active
and then Present (Component_Associations (N))
then
declare
Comp : Node_Id;
begin
Comp := First (Component_Associations (N));
while Present (Comp) loop
if Box_Present (Comp) then
Insert_Actions (N, Freeze_Entity (Typ, N));
exit;
end if;
Next (Comp);
end loop;
end;
end if;
-- An unqualified aggregate is restricted in SPARK to:
-- An aggregate item inside an aggregate for a multi-dimensional array

12
gcc/ada/sem_attr.adb
View File

@ -4102,15 +4102,9 @@ package body Sem_Attr is
Analyze_And_Resolve (N, Etype (PS));
else
if Ada_Version >= Ada_2012 then
Error_Attr
("% attribute can only appear" &
" in function Postcondition pragma or Post aspect", P);
else
Error_Attr
("% attribute can only appear" &
" in function Postcondition pragma", P);
end if;
Error_Attr
("% attribute can only appear in postcondition of function",
P);
end if;
end if;
end Result;

22
gcc/ada/sem_ch6.adb
View File

@ -638,6 +638,28 @@ package body Sem_Ch6 is
return;
else
-- The resolution of a controlled [extension] aggregate associated
-- with a return statement creates a temporary which needs to be
-- finalized on function exit. Wrap the return statement inside a
-- block so that the finalization machinery can detect this case.
-- This early expansion is done only when the return statement is
-- not part of a handled sequence of statements.
if Nkind_In (Expr, N_Aggregate,
N_Extension_Aggregate)
and then Needs_Finalization (R_Type)
and then Nkind (Parent (N)) /= N_Handled_Sequence_Of_Statements
then
Rewrite (N,
Make_Block_Statement (Loc,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Relocate_Node (N)))));
Analyze (N);
return;
end if;
Analyze_And_Resolve (Expr, R_Type);
Check_Limited_Return (Expr);
end if;

8
gcc/ada/sem_res.adb
View File

@ -3736,7 +3736,13 @@ package body Sem_Res is
-- Is_OK_Variable_For_Out_Formal generates the required
-- reference in this case.
if not Is_OK_Variable_For_Out_Formal (A) then
-- A call to an initialization procedure for an aggregate
-- component may initialize a nested component of a constant
-- designated object. In this context the object is variable.
if not Is_OK_Variable_For_Out_Formal (A)
and then not Is_Init_Proc (Nam)
then
Error_Msg_NE ("actual for& must be a variable", A, F);
end if;