diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 50 | ||||
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 39 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 2 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/prj-part.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 23 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 8 |
13 files changed, 200 insertions, 42 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3aa9c77..9e5ec15 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,55 @@ 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 "with Identifier'Class =>" as an aspect, so that a meaningful warning is issued in Strict mode. diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index d12c92c..13396c9 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -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; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 5cade6c..c8411f9 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -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; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 670c23c..9d3730d 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -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 diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index a2058e2..70d0b2b 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -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; diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index dbb5473..8985e97 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -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 diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index fede1f9..a164099 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -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); diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 62a3fa9..670a0a07 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -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; ------------ diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index e300dd9..5942abc 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -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; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 050930b..948410d 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -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 diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index d1f927a..70c745d 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -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; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 847f920..054c7a8 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 294322d..56f1457 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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; |