Commit de6cad7c by Arnaud Charlet

[multiple changes]

2012-12-05  Ed Schonberg  <schonberg@adacore.com>

	* par-ch6.adb (P_Return_Object_Declaration): Do not check for
	legality of Aliased keyword.
	* sem_ch6.adb (Analyze_Function_Return): The keyword aliased is
	legal in an extended return statement only if the return type
	is immutably limited.

2012-12-05  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Expand_Interface_Thunk): Simplify
	management of controlling formals.  Required to avoid problems
	with primitives of internally generated base types associated
	with constrained tagged types.

From-SVN: r194201
parent ac2b960f
2012-12-05 Ed Schonberg <schonberg@adacore.com>
* par-ch6.adb (P_Return_Object_Declaration): Do not check for
legality of Aliased keyword.
* sem_ch6.adb (Analyze_Function_Return): The keyword aliased is
legal in an extended return statement only if the return type
is immutably limited.
2012-12-05 Javier Miranda <miranda@adacore.com>
* exp_disp.adb (Expand_Interface_Thunk): Simplify
management of controlling formals. Required to avoid problems
with primitives of internally generated base types associated
with constrained tagged types.
2012-12-05 Ed Schonberg <schonberg@adacore.com>
* sem_eval.adb: Remove spurious warnings.
2012-12-05 Ed Schonberg <schonberg@adacore.com>
......
......@@ -1635,7 +1635,6 @@ package body Exp_Disp is
Formals : constant List_Id := New_List;
Target : constant Entity_Id := Ultimate_Alias (Prim);
Controlling_Typ : Entity_Id;
Decl_1 : Node_Id;
Decl_2 : Node_Id;
Expr : Node_Id;
......@@ -1713,8 +1712,6 @@ package body Exp_Disp is
Next_Formal (Formal);
end loop;
Controlling_Typ := Find_Dispatching_Type (Target);
Target_Formal := First_Formal (Target);
Formal := First (Formals);
while Present (Formal) loop
......@@ -1741,7 +1738,7 @@ package body Exp_Disp is
if Ekind (Target_Formal) = E_In_Parameter
and then Ekind (Etype (Target_Formal)) = E_Anonymous_Access_Type
and then Ftyp = Controlling_Typ
and then Is_Controlling_Formal (Target_Formal)
then
-- Generate:
-- type T is access all <<type of the target formal>>
......@@ -1799,7 +1796,7 @@ package body Exp_Disp is
(Defining_Identifier (Decl_2),
New_Reference_To (Defining_Identifier (Decl_1), Loc)));
elsif Ftyp = Controlling_Typ then
elsif Is_Controlling_Formal (Target_Formal) then
-- Generate:
-- S1 : Storage_Offset := Storage_Offset!(Formal'Address)
......
......@@ -1721,13 +1721,8 @@ package body Ch6 is
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 Ada 2012?");
else
Error_Msg_SC -- CODEFIX
("ALIASED not allowed in extended return");
end if;
-- The restrictions on the use of aliased in an extended return
-- are semantic, not syntactic.
if Token = Tok_Constant then
Scan; -- past CONSTANT
......
......@@ -787,6 +787,7 @@ package body Sem_Ch6 is
Analyze_And_Resolve (Expr, R_Type);
Check_Limited_Return (Expr);
end if;
-- RETURN only allowed in SPARK as the last statement in function
......@@ -806,8 +807,9 @@ package body Sem_Ch6 is
-- Analyze parts specific to extended_return_statement:
declare
Obj_Decl : constant Node_Id :=
Obj_Decl : constant Node_Id :=
Last (Return_Object_Declarations (N));
Has_Aliased : constant Boolean := Aliased_Present (Obj_Decl);
HSS : constant Node_Id := Handled_Statement_Sequence (N);
......@@ -842,6 +844,19 @@ package body Sem_Ch6 is
Set_Referenced (Defining_Identifier (Obj_Decl));
Check_References (Stm_Entity);
-- Check RM 6.5 (5.9/3)
if Has_Aliased then
if Ada_Version < Ada_2012 then
Error_Msg_N ("aliased only allowed for limited"
& " return objects in Ada 2012?", N);
elsif not Is_Immutably_Limited_Type (R_Type) then
Error_Msg_N ("aliased only allowed for limited"
& " return objects", N);
end if;
end if;
end;
end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment