+2011-10-14 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_res.adb: Minor reformatting.
+
+2011-10-14 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call):
+ Code and comment reformatting. Use BIP_Task_Master
+ when creating a _master.
+ (BIP_Formal_Suffix): Code reformatting. Correct the case for
+ BIP_Task_Master.
+ (Make_Build_In_Place_Call_In_Object_Declaration): Use
+ BIP_Task_Master when creating a reference to the enclosing
+ function's _master formal.
+ (Move_Activation_Chain): Use BIP_Task_Master when creating a reference
+ to the _master.
+ * exp_ch6.ads: Change BIP_Master to BIP_Task_Master.
+ (Needs_BIP_Finalization_Master): Alphabetized.
+ * sem_ch6.adb (Create_Extra_Formals): Update the usage of
+ BIP_Task_Master.
+
+2011-10-14 Ed Schonberg <schonberg@adacore.com>
+
+ * par-ch6.adb (P_Return_Object_Declaration): In Ada 2012 mode,
+ reject an aliased keyword on the object declaration of an extended
+ return statement. In older versions of the language indicate
+ that this is illegal in the standard.
+
+2011-10-14 Pascal Obry <obry@adacore.com>
+
+ * sem_util.adb, sem_ch4.adb: Minor reformatting.
+
+2011-10-14 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch13.adb: Recognize properly procedure calls that are
+ transformed into code statements.
+
+2011-10-14 Vincent Celier <celier@adacore.com>
+
+ * projects.texi: Minor fix in project example.
+
2011-10-14 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb: Return objects are aliased if their type is
Function_Id : Entity_Id;
Master_Actual : Node_Id)
is
- Loc : constant Source_Ptr := Sloc (Function_Call);
- Result_Subt : constant Entity_Id := Available_View (Etype (Function_Id));
- Actual : Node_Id := Master_Actual;
+ Loc : constant Source_Ptr := Sloc (Function_Call);
+ Result_Subt : constant Entity_Id :=
+ Available_View (Etype (Function_Id));
+ Actual : Node_Id;
+ Chain_Actual : Node_Id;
+ Chain_Formal : Node_Id;
+ Master_Formal : Node_Id;
begin
-- No such extra parameters are needed if there are no tasks
return;
end if;
+ Actual := Master_Actual;
+
-- Use a dummy _master actual in case of No_Task_Hierarchy
if Restriction_Active (No_Task_Hierarchy) then
Actual := New_Reference_To (Actual, Loc);
end if;
- -- The master
-
- declare
- Master_Formal : Node_Id;
-
- begin
- -- Locate implicit master parameter in the called function
-
- Master_Formal := Build_In_Place_Formal (Function_Id, BIP_Master);
- Analyze_And_Resolve (Actual, Etype (Master_Formal));
-
- -- Build the parameter association for the new actual and add it to
- -- the end of the function's actuals.
+ -- Locate the implicit master parameter in the called function
- Add_Extra_Actual_To_Call (Function_Call, Master_Formal, Actual);
- end;
+ Master_Formal := Build_In_Place_Formal (Function_Id, BIP_Task_Master);
+ Analyze_And_Resolve (Actual, Etype (Master_Formal));
- -- The activation chain
+ -- Build the parameter association for the new actual and add it to the
+ -- end of the function's actuals.
- declare
- Activation_Chain_Actual : Node_Id;
- Activation_Chain_Formal : Node_Id;
+ Add_Extra_Actual_To_Call (Function_Call, Master_Formal, Actual);
- begin
- -- Locate implicit activation chain parameter in the called function
+ -- Locate the implicit activation chain parameter in the called function
- Activation_Chain_Formal :=
- Build_In_Place_Formal (Function_Id, BIP_Activation_Chain);
+ Chain_Formal :=
+ Build_In_Place_Formal (Function_Id, BIP_Activation_Chain);
- -- Create the actual which is a pointer to the current activation
- -- chain
+ -- Create the actual which is a pointer to the current activation chain
- Activation_Chain_Actual :=
- Make_Attribute_Reference (Loc,
- Prefix => Make_Identifier (Loc, Name_uChain),
- Attribute_Name => Name_Unrestricted_Access);
+ Chain_Actual :=
+ Make_Attribute_Reference (Loc,
+ Prefix => Make_Identifier (Loc, Name_uChain),
+ Attribute_Name => Name_Unrestricted_Access);
- Analyze_And_Resolve
- (Activation_Chain_Actual, Etype (Activation_Chain_Formal));
+ Analyze_And_Resolve (Chain_Actual, Etype (Chain_Formal));
- -- Build the parameter association for the new actual and add it to
- -- the end of the function's actuals.
+ -- Build the parameter association for the new actual and add it to the
+ -- end of the function's actuals.
- Add_Extra_Actual_To_Call
- (Function_Call, Activation_Chain_Formal, Activation_Chain_Actual);
- end;
+ Add_Extra_Actual_To_Call (Function_Call, Chain_Formal, Chain_Actual);
end Add_Task_Actuals_To_Build_In_Place_Call;
-----------------------
case Kind is
when BIP_Alloc_Form =>
return "BIPalloc";
- when BIP_Storage_Pool =>
+ when BIP_Storage_Pool =>
return "BIPstoragepool";
when BIP_Finalization_Master =>
return "BIPfinalizationmaster";
- when BIP_Master =>
- return "BIPmaster";
+ when BIP_Task_Master =>
+ return "BIPtaskmaster";
when BIP_Activation_Chain =>
return "BIPactivationchain";
when BIP_Object_Access =>
(Func : Entity_Id;
Kind : BIP_Formal_Kind) return Entity_Id
is
+ Formal_Name : constant Name_Id :=
+ New_External_Name
+ (Chars (Func), BIP_Formal_Suffix (Kind));
Extra_Formal : Entity_Id := Extra_Formals (Func);
begin
loop
pragma Assert (Present (Extra_Formal));
- exit when
- Chars (Extra_Formal) =
- New_External_Name (Chars (Func), BIP_Formal_Suffix (Kind));
+ exit when Chars (Extra_Formal) = Formal_Name;
+
Next_Formal_With_Extras (Extra_Formal);
end loop;
-- New master
New_Reference_To
- (Build_In_Place_Formal (Par_Func, BIP_Master), Loc)));
+ (Build_In_Place_Formal (Par_Func, BIP_Task_Master), Loc)));
end Move_Activation_Chain;
-- Start of processing for Expand_N_Extended_Return_Statement
Add_Task_Actuals_To_Build_In_Place_Call
(Func_Call, Function_Id,
Master_Actual =>
- New_Reference_To
- (Build_In_Place_Formal (Enclosing_Func, BIP_Master), Loc));
+ New_Reference_To (Build_In_Place_Formal
+ (Enclosing_Func, BIP_Task_Master), Loc));
else
Add_Task_Actuals_To_Build_In_Place_Call
-- Present if result type needs finalization. Pointer to caller's
-- finalization master.
- BIP_Master,
+ BIP_Task_Master,
-- Present if result type contains tasks. Master associated with
-- calling context.
-- for which Is_Build_In_Place_Call is True, or an N_Qualified_Expression
-- node applied to such a function call.
- function Needs_BIP_Finalization_Master (Func_Id : Entity_Id) return Boolean;
- -- Ada 2005 (AI-318-02): Return True if the function needs an implicit
- -- finalization master implicit parameter.
-
function Needs_BIP_Alloc_Form (Func_Id : Entity_Id) return Boolean;
-- Ada 2005 (AI-318-02): Return True if the function needs an implicit
-- BIP_Alloc_Form parameter (see type BIP_Formal_Kind).
+ function Needs_BIP_Finalization_Master (Func_Id : Entity_Id) return Boolean;
+ -- Ada 2005 (AI-318-02): Return True if the result subtype of function
+ -- Func_Id needs finalization actions.
+
function Needs_Result_Accessibility_Level
(Func_Id : Entity_Id) return Boolean;
-- Ada 2012 (AI05-0234): Return True if the function needs an implicit
Scan; -- past ALIASED
Set_Aliased_Present (Decl_Node);
+ if Ada_Version < Ada_2012 then
+ Error_Msg_SC -- CODEFIX
+ ("ALIASED not allowed in extended return in Ada2012?");
+ else
+ Error_Msg_SC -- CODEFIX
+ ("ALIASED not allowed in extended return");
+ end if;
+
if Token = Tok_Constant then
Scan; -- past CONSTANT
Set_Constant_Present (Decl_Node);
@b{for} Object_Dir @b{use} "obj";
@b{for} Exec_Dir @b{use} ".";
@b{for} Main @b{use} ("proc.adb");
- @b{end} Build;
- @b{package} Builder @b{is} --<<< for gnatmake and gprbuild
- @b{end} Builder;
+ @b{package} Builder @b{is} --<<< for gnatmake and gprbuild
+ @b{end} Builder;
- @b{package} Compiler @b{is} --<<< for the compiler
- @b{end} Compiler;
+ @b{package} Compiler @b{is} --<<< for the compiler
+ @b{end} Compiler;
- @b{package} Binder @b{is} --<<< for the binder
- @b{end} Binder;
+ @b{package} Binder @b{is} --<<< for the binder
+ @b{end} Binder;
- @b{package} Linker @b{is} --<<< for the linker
- @b{end} Linker;
+ @b{package} Linker @b{is} --<<< for the linker
+ @b{end} Linker;
+ @b{end} Build;
@end smallexample
@noindent
while Present (Stmt) loop
StmtO := Original_Node (Stmt);
+ -- A procedure call transformed into a code statement is OK.
+
if Ada_Version >= Ada_2012
and then Nkind (StmtO) = N_Procedure_Call_Statement
+ and then Nkind (Name (StmtO)) = N_Qualified_Expression
then
null;
-- Unary operator case
else
- if Op_Name = Name_Op_Subtract or else
- Op_Name = Name_Op_Add or else
- Op_Name = Name_Op_Abs
+ if Op_Name = Name_Op_Subtract
+ or else Op_Name = Name_Op_Add
+ or else Op_Name = Name_Op_Abs
then
Find_Unary_Types (Act1, Op_Id, N);
begin
- -- Check whether type has a specified indexing aspect.
+ -- Check whether type has a specified indexing aspect
Func_Name := Empty;
Is_Var := False;
while Present (Ritem) loop
if Nkind (Ritem) = N_Aspect_Specification then
- -- Prefer Variable_Indexing, but will settle for Constant.
+ -- Prefer Variable_Indexing, but will settle for Constant
if Get_Aspect_Id (Chars (Identifier (Ritem))) =
Aspect_Constant_Indexing
if Success then
Set_Etype (Name (N), It.Typ);
- -- Add implicit dereference interpretation.
+ -- Add implicit dereference interpretation
Disc := First_Discriminant (Etype (It.Nam));
Discard :=
Add_Extra_Formal
(E, RTE (RE_Master_Id),
- E, BIP_Formal_Suffix (BIP_Master));
+ E, BIP_Formal_Suffix (BIP_Task_Master));
Discard :=
Add_Extra_Formal
(E, RTE (RE_Activation_Chain_Access),
-- evaluation of the corresponding "and then" or "or else". If we left
-- the replacement to expansion time, then run-time checks associated
-- with such operands would be evaluated unconditionally, due to being
- -- before to the condition prior to the rewriting as short-circuit forms
+ -- before the condition prior to the rewriting as short-circuit forms
-- during expansion.
if Short_Circuit_And_Or
function Effective_Extra_Accessibility (Id : Entity_Id) return Entity_Id is
begin
if Present (Renamed_Object (Id))
- and then Is_Entity_Name (Renamed_Object (Id)) then
+ and then Is_Entity_Name (Renamed_Object (Id))
+ then
return Effective_Extra_Accessibility (Entity (Renamed_Object (Id)));
end if;
-- Check for components
elsif
- Nkind_In (Expr, N_Selected_Component, N_Indexed_Component) then
+ Nkind_In (Expr, N_Selected_Component, N_Indexed_Component)
+ then
Expr := Prefix (Expr);
Off := True;