+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
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
-- 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
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;
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;
@noindent
Syntax:
@smallexample @c ada
-pragma Annotate (IDENTIFIER [,IDENTIFIER] @{, ARG@});
+pragma Annotate (IDENTIFIER [,IDENTIFIER @{, ARG@}]);
ARG ::= NAME | EXPRESSION
@end smallexample
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;
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
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;
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);
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
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);
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
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;
------------
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
--
-- 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;
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 :=
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,
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,
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;
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
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;
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;
-- 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;
projects / gcc.git / commitdiff